Changeset 10222


Ignore:
Timestamp:
2018-10-25T11:42:23+02:00 (2 years ago)
Author:
aumont
Message:

update of the sediment module + enhancement, bug correction in PISCES generating O2 negative values

Location:
NEMO/trunk/src
Files:
31 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/IOM/iom.F90

    r10068 r10222  
    4343   USE ioipsl, ONLY :  ju2ymds    ! for calendar 
    4444   USE crs             ! Grid coarsening 
     45#if defined key_top 
     46   USE trc, ONLY    :  profsed 
     47#endif 
    4548   USE lib_fortran  
    4649   USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 
     
    193196      ! vertical grid definition 
    194197      IF(.NOT.llrst_context) THEN 
    195           CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 
    196           CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 
    197           CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 
    198           CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 
     198          CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d ) 
     199          CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d ) 
     200          CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d ) 
     201          CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d ) 
    199202 
    200203          ! Add vertical grid bounds 
     
    219222          CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 
    220223# endif 
     224#if defined key_top 
     225          CALL iom_set_axis_attr( "profsed", paxis = profsed ) 
     226#endif 
    221227          CALL iom_set_axis_attr( "icbcla", class_num ) 
    222228          CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 
  • NEMO/trunk/src/OFF/dtadyn.F90

    r10213 r10222  
    4646   PRIVATE 
    4747 
    48    PUBLIC   dta_dyn_init   ! called by opa.F90 
    49    PUBLIC   dta_dyn        ! called by step.F90 
    50    PUBLIC   dta_dyn_swp   ! called by step.F90 
     48   PUBLIC   dta_dyn_init       ! called by opa.F90 
     49   PUBLIC   dta_dyn            ! called by step.F90 
     50   PUBLIC   dta_dyn_sed_init   ! called by opa.F90 
     51   PUBLIC   dta_dyn_sed        ! called by step.F90 
     52   PUBLIC   dta_dyn_swp        ! called by step.F90 
    5153 
    5254   CHARACTER(len=100) ::   cn_dir          !: Root directory for location of ssr files 
     
    183185         CALL prt_ctl(tab3d_1=uslp             , clinfo1=' slp  - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 
    184186         CALL prt_ctl(tab3d_1=wslpi            , clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
    185 !         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask ) 
    186 !         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask ) 
    187 !         CALL prt_ctl(tab2d_1=fmmflx           , clinfo1=' fmmflx  - : ', mask1=tmask ) 
    188 !         CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', mask1=tmask ) 
    189 !         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask ) 
    190 !         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask ) 
    191187      ENDIF 
    192188      ! 
     
    419415   END SUBROUTINE dta_dyn_init 
    420416 
     417   SUBROUTINE dta_dyn_sed( kt ) 
     418      !!---------------------------------------------------------------------- 
     419      !!                  ***  ROUTINE dta_dyn  *** 
     420      !! 
     421      !! ** Purpose :  Prepares dynamics and physics fields from a NEMO run 
     422      !!               for an off-line simulation of passive tracers 
     423      !! 
     424      !! ** Method : calculates the position of data 
     425      !!             - computes slopes if needed 
     426      !!             - interpolates data if needed 
     427      !!---------------------------------------------------------------------- 
     428      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     429      ! 
     430      !!---------------------------------------------------------------------- 
     431      ! 
     432      IF( ln_timing )   CALL timing_start( 'dta_dyn_sed') 
     433      ! 
     434      nsecdyn = nsec_year + nsec1jan000   ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
     435      ! 
     436      IF( kt == nit000 ) THEN    ;    nprevrec = 0 
     437      ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec_a(2) 
     438      ENDIF 
     439      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==! 
     440      ! 
     441      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature 
     442      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity 
     443      ! 
     444      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 
     445 
     446      IF(ln_ctl) THEN                  ! print control 
     447         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask,  kdim=jpk   ) 
     448         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn      - : ', mask1=tmask,  kdim=jpk   ) 
     449      ENDIF 
     450      ! 
     451      IF( ln_timing )   CALL timing_stop( 'dta_dyn_sed') 
     452      ! 
     453   END SUBROUTINE dta_dyn_sed 
     454 
     455 
     456   SUBROUTINE dta_dyn_sed_init 
     457      !!---------------------------------------------------------------------- 
     458      !!                  ***  ROUTINE dta_dyn_init  *** 
     459      !! 
     460      !! ** Purpose :   Initialisation of the dynamical data 
     461      !! ** Method  : - read the data namdta_dyn namelist 
     462      !!---------------------------------------------------------------------- 
     463      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
     464      INTEGER  :: ifpr                               ! dummy loop indice 
     465      INTEGER  :: jfld                               ! dummy loop arguments 
     466      INTEGER  :: inum, idv, idimv                   ! local integer 
     467      INTEGER  :: ios                                ! Local integer output status for namelist read 
     468      !! 
     469      CHARACTER(len=100)            ::  cn_dir        !   Root directory for location of core files 
     470      TYPE(FLD_N), DIMENSION(2) ::  slf_d         ! array of namelist informations on the fields to read 
     471      TYPE(FLD_N) :: sn_tem , sn_sal   !   "                 " 
     472      !! 
     473      NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth,  fwbcorr, & 
     474         &                sn_tem, sn_sal 
     475      !!---------------------------------------------------------------------- 
     476      ! 
     477      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
     478      READ  ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 
     479901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 
     480      REWIND( numnam_cfg )              ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 
     481      READ  ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 
     482902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 
     483      IF(lwm) WRITE ( numond, namdta_dyn ) 
     484      !                                         ! store namelist information in an array 
     485      !                                         ! Control print 
     486      IF(lwp) THEN 
     487         WRITE(numout,*) 
     488         WRITE(numout,*) 'dta_dyn : offline dynamics ' 
     489         WRITE(numout,*) '~~~~~~~ ' 
     490         WRITE(numout,*) '   Namelist namdta_dyn' 
     491         WRITE(numout,*) '      runoffs option enabled (T) or not (F)            ln_dynrnf        = ', ln_dynrnf 
     492         WRITE(numout,*) '      runoffs is spread in vertical                    ln_dynrnf_depth  = ', ln_dynrnf_depth 
     493         WRITE(numout,*) '      annual global mean of empmr for ssh correction   fwbcorr          = ', fwbcorr 
     494         WRITE(numout,*) 
     495      ENDIF 
     496      ! 
     497      jf_tem  = 1     ;   jf_sal  = 2    ;   jfld   = jf_sal 
     498      ! 
     499      slf_d(jf_tem)  = sn_tem    ;   slf_d(jf_sal)  = sn_sal 
     500      ! 
     501      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
     502      IF( ierr > 0 )  THEN 
     503         CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN 
     504      ENDIF 
     505      !                                         ! fill sf with slf_i and control print 
     506      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 
     507      ! 
     508      ! Open file for each variable to get his number of dimension 
     509      DO ifpr = 1, jfld 
     510         CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 
     511         idv   = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar )        ! id of the variable sdjf%clvar 
     512         idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv)                 ! number of dimension for variable sdjf%clvar 
     513         IF( sf_dyn(ifpr)%num /= 0 )   CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 
     514         ierr1=0 
     515         IF( idimv == 3 ) THEN    ! 2D variable 
     516                                      ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 ) 
     517            IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 ) 
     518         ELSE                     ! 3D variable 
     519                                      ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk)  , STAT=ierr0 ) 
     520            IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 ) 
     521         ENDIF 
     522         IF( ierr0 + ierr1 > 0 ) THEN 
     523            CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' )   ;   RETURN 
     524         ENDIF 
     525      END DO 
     526      ! 
     527      CALL dta_dyn_sed( nit000 ) 
     528      ! 
     529   END SUBROUTINE dta_dyn_sed_init 
    421530 
    422531   SUBROUTINE dta_dyn_swp( kt ) 
  • NEMO/trunk/src/OFF/nemogcm.F90

    r10068 r10222  
    110110         IF( istp /= nit000 )   CALL day        ( istp )         ! Calendar (day was already called at nit000 in day_init) 
    111111                                CALL iom_setkt  ( istp - nit000 + 1, cxios_context )   ! say to iom that we are at time step kstp 
     112#if defined key_sed_off 
     113                                CALL dta_dyn_sed( istp )         ! Interpolation of the dynamical fields 
     114#else 
    112115                                CALL dta_dyn    ( istp )         ! Interpolation of the dynamical fields 
    113116         IF( .NOT.ln_linssh )   CALL dta_dyn_swp( istp )         ! swap of sea  surface height and vertical scale factors 
    114  
     117#endif 
    115118                                CALL trc_stp    ( istp )         ! time-stepping 
    116119                                CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
     
    287290                           CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
    288291                           CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
     292#if defined key_sed_off 
     293                           CALL dta_dyn_sed_init ! Initialization for the dynamics 
     294#else 
    289295                           CALL dta_dyn_init   ! Initialization for the dynamics 
     296#endif 
    290297 
    291298                           CALL     trc_init   ! Passive tracers initialization 
  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90

    r10068 r10222  
    3737   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tempis   ! In situ temperature 
    3838 
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
    41    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akf3       !: ??? 
    42    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aks3       !: ??? 
    43    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak1p3      !: ??? 
    44    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak2p3      !: ??? 
    45    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak3p3      !: ??? 
    46    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksi3      !: ??? 
    47    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
    48    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fluorid    !: ??? 
    49    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sulfat     !: ??? 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akf3       !: ??? 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aks3       !: ??? 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak1p3      !: ??? 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak2p3      !: ??? 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak3p3      !: ??? 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksi3      !: ??? 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fluorid    !: ??? 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sulfat     !: ??? 
    5050 
    5151   !!* Variable for chemistry of the CO2 cycle 
     
    233233        END DO 
    234234 
    235  
    236  
    237235      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    238236      ! ------------------------------- 
     
    449447      ! 
    450448   END SUBROUTINE p4z_che 
    451  
    452449 
    453450   SUBROUTINE ahini_for_at(p_hini) 
  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmeso.F90

    r10069 r10222  
    108108               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    109109               zdenom2   = zdenom / ( zfood + rtrn ) 
    110                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)  
     110               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
    111111 
    112112               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zrem.F90

    r10069 r10222  
    116116                  zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
    117117                  denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    118                   zoxyrem           = zammonic *        nitrfac2(ji,jj,jk) 
     118                  denitr(ji,jj,jk)  = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
     119                  zoxyrem           = zammonic - denitr(ji,jj,jk) 
    119120                  ! 
    120121                  zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     
    189190               &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
    190191               zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
     192               zdenitnh4 = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 )  
    191193               ! Update of the tracers trends 
    192194               ! ---------------------------- 
  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90

    r10213 r10222  
    101101      ENDIF 
    102102      ! 
     103      IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients  
     104      ! 
     105#if ! defined key_sed_off 
    103106      CALL p4z_che              ! computation of chemical constants 
    104107      CALL p4z_int( kt )        ! computation of various rates for biogeochemistry 
    105108      ! 
    106       IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients  
    107  
    108109      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    109110         ! 
     
    149150         END DO 
    150151      END IF 
    151       ! 
    152       IF( lk_sed ) THEN  
     152#endif 
     153      ! 
     154      IF( ln_sediment ) THEN  
    153155         ! 
    154156         CALL sed_model( kt )     !  Main program of Sediment model 
     157         ! 
     158         IF( ln_top_euler ) THEN 
     159            DO jn = jp_pcs0, jp_pcs1 
     160               trn(:,:,:,jn) = trb(:,:,:,jn) 
     161            END DO 
     162         ENDIF 
    155163         ! 
    156164      ENDIF 
     
    352360      IF(lwp)  WRITE(numout,*) 
    353361 
    354       IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca" ) THEN 
     362      IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN 
    355363         IF( .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) ! 
    356364            !                                                ! --------------------------- ! 
  • NEMO/trunk/src/TOP/PISCES/SED/par_sed.F90

    r10068 r10222  
    77   !!        !  06-12  (C. Ethe)  Orignal 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_sed 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_sed'                                                  Sediment  
    12    !!---------------------------------------------------------------------- 
     9   !! $Id$ 
    1310 
    1411   !! Domain characteristics 
     
    1916      jpim1    =>   jpim1 ,  & !: jpi - 1 
    2017      jpjm1    =>   jpjm1 ,  & !: jpj - 1 
    21       jpij     =>   jpij      !: jpi x jpj 
    22       jp_tem   =>   jp_tem    !: indice of temperature 
     18      jpij     =>   jpij  ,  & !: jpi x jpj 
     19      jp_tem   =>   jp_tem,  & !: indice of temperature 
    2320      jp_sal   =>   jp_sal     !: indice of salintity 
    2421 
    25 #if ! defined key_sed_off 
    26    USE par_pisces 
    27 #endif 
    28  
    29    INTEGER, PARAMETER :: jpdta = 12 
    30  
     22   INTEGER, PARAMETER :: jpdta = 17 
    3123 
    3224   ! Vertical sediment geometry 
    33    INTEGER, PARAMETER :: & 
    34       jpksed   = 11         ,   & !: number of sediment layers 
    35       jpksedm1 = jpksed - 1  
    36        
     25   INTEGER, PUBLIC   ::      & 
     26      jpksed   = 11 ,        & 
     27      jpksedm1 = 10 
     28 
    3729   ! sediment tracer species 
    38    INTEGER, PARAMETER :: & 
    39       jpsol = 4,         &  !: number of solid component 
    40       jpwat = 7,         &   !: number of pore water component 
    41       jpwatp1 = jpwat + 1 
     30   INTEGER, PARAMETER ::    & 
     31      jpsol =  8,           &  !: number of solid component 
     32      jpwat = 10,           &   !: number of pore water component 
     33      jpwatp1 = jpwat +1,   & 
     34      jpsol1 = jpsol - 1 
     35 
    4236    
    4337   ! pore water components        
     
    4943      jwpo4  = 5,        & !: phosphate 
    5044      jwalk  = 6,        & !: alkalinity 
    51       jwc13  = 7           !: dissolved inorganic carbon 13 
     45      jwnh4  = 7,        & !: Ammonium 
     46      jwh2s  = 8,        & !: Sulfate 
     47      jwso4  = 9,        & !: H2S 
     48      jwfe2  = 10          !: Fe2+ 
    5249 
    5350   ! solid components        
     
    5653      jsclay  = 2,        & !: clay 
    5754      jspoc   = 3,        & !: organic carbon 
    58       jscal   = 4           !: calcite 
     55      jscal   = 4,        & !: calcite 
     56      jspos   = 5,        & !: semi-ref POC 
     57      jspor   = 6,        & !: refractory POC 
     58      jsfeo   = 7,        & !: iron hydroxides 
     59      jsfes   = 8           !: FeS 
    5960 
    6061   INTEGER, PARAMETER ::  & 
    6162      jptrased   = jpsol + jpwat , & 
    62       jpdia3dsed = 3          , & 
    63       jpdia2dsed = 7 
    64 #endif 
     63      jpdia3dsed = 2             , & 
     64      jpdia2dsed = 12 
    6565 
    66    !!---------------------------------------------------------------------- 
    67    !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    68    !! $Id$  
    69    !! Software governed by the CeCILL license (see ./LICENSE) 
    70    !!====================================================================== 
    7166END MODULE par_sed 
  • NEMO/trunk/src/TOP/PISCES/SED/sed.F90

    r9124 r10222  
    77   !!        !  06-12  (C. Ethe)  Orignal 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_sed 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_sed'                                                  Sediment  
    12    !!---------------------------------------------------------------------- 
    139   USE par_sed 
     10   USE oce_sed 
    1411   USE in_out_manager 
     12 
    1513 
    1614   IMPLICIT NONE 
    1715   PUBLIC 
    1816 
    19    PUBLIC sed_alloc    
    20  
    21    USE dom_oce , ONLY :   nidom     =>   nidom          !: 
    22    USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    23    USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    24    USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m) 
    25    USE dom_oce , ONLY :   mbkt      =>   mbkt           !: vertical index of the bottom last T- ocean level 
    26    USE dom_oce , ONLY :   tmask     =>   tmask          !: land/ocean mask at t-points 
    27    USE dom_oce , ONLY :   rdt       =>   rdt            !: time step for the dynamics 
    28    USE dom_oce , ONLY :   nyear     =>   nyear          !: Current year 
    29    USE dom_oce , ONLY :   nmonth    =>   nmonth         !: Current month 
    30    USE dom_oce , ONLY :   nday      =>   nday           !: Current day 
    31    USE dom_oce , ONLY :   ndastp    =>   ndastp         !: time step date in year/month/day aammjj 
    32    USE dom_oce , ONLY :   nday_year =>   nday_year      !: curent day counted from jan 1st of the current year 
    33    USE dom_oce , ONLY :   adatrj    =>   adatrj         !: number of elapsed days since the begining of the run 
    34    !                                !: it is the accumulated duration of previous runs 
    35    !                                !: that may have been run with different time steps. 
    36  
    37 #if ! defined key_sed_off 
    38  
    39    USE oce     , ONLY :  tsn        =>   tsn             !: pot. temperature (celsius) and salinity (psu) 
    40  
    41    USE trc     , ONLY :  trn        =>   trc             !: tracer  
    42    USE trc     , ONLY :  nwritetrc  =>   nwritetrc       !: outputs frequency of tracer model 
    43  
    44    USE p4zsink , ONLY :  sinking    =>   sinking         !: sinking flux for POC 
    45    USE p4zsink , ONLY :  sinking2   =>   sinking2        !: sinking flux for GOC 
    46    USE p4zsink , ONLY :  sinkcal    =>   sinkcal         !: sinking flux for calcite 
    47    USE p4zsink , ONLY :  sinksil    =>   sinksil         !: sinking flux for opal ( dsi ) 
    48  
    49    USE sms_pisces, ONLY : akb3      =>   akb3            !: Chemical constants   
    50    USE sms_pisces, ONLY : ak13      =>   ak13            !: Chemical constants   
    51    USE sms_pisces, ONLY : ak23      =>   ak23            !: Chemical constants   
    52    USE sms_pisces, ONLY : akw3      =>   akw3            !: Chemical constants   
    53    USE sms_pisces, ONLY : aksp      =>   aksp            !: Chemical constants   
    54    USE sms_pisces, ONLY : borat     =>   borat           !: Chemical constants ( borat )  
    55  
    56 #endif    
    57  
     17   PUBLIC sed_alloc 
    5818 
    5919   !! Namelist 
    60    REAL(wp), PUBLIC, DIMENSION(5) ::  reac                !: reactivity rc in  [l.mol-1.s-1] 
    6120   REAL(wp), PUBLIC               ::  reac_sil            !: reactivity of silicate in  [l.mol-1.s-1] 
    6221   REAL(wp), PUBLIC               ::  reac_clay           !: reactivity of clay in  [l.mol-1.s-1] 
    63    REAL(wp), PUBLIC               ::  reac_poc            !: reactivity of poc in  [l.mol-1.s-1] 
    64    REAL(wp), PUBLIC               ::  reac_no3            !: reactivity of no3 in  [l.mol-1.s-1] 
     22   REAL(wp), PUBLIC               ::  reac_ligc           !: reactivity of Ligands [l.mol-1.s-1] 
     23   REAL(wp), PUBLIC               ::  reac_pocl           !: reactivity of pocl in  [s-1] 
     24   REAL(wp), PUBLIC               ::  reac_pocs           !: reactivity of pocs in  [s-1] 
     25   REAL(wp), PUBLIC               ::  reac_pocr           !: reactivity of pocr in  [s-1] 
     26   REAL(wp), PUBLIC               ::  reac_nh4            !: reactivity of NH4 in  [l.mol-1.s-1] 
     27   REAL(wp), PUBLIC               ::  reac_h2s            !: reactivity of ODU in  [l.mol-1.s-1] 
     28   REAL(wp), PUBLIC               ::  reac_fe2            !: reactivity of Fe2+ in  [l.mol-1.s-1] 
     29   REAL(wp), PUBLIC               ::  reac_feh2s          !: reactivity of Fe2+ in  [l.mol-1.s-1] 
     30   REAL(wp), PUBLIC               ::  reac_fes            !: reactivity of Fe with H2S in  [l.mol-1.s-1] 
     31   REAL(wp), PUBLIC               ::  reac_feso           !: reactivity of FeS with O2 in  [l.mol-1.s-1] 
    6532   REAL(wp), PUBLIC               ::  reac_cal            !: reactivity of cal in  [l.mol-1.s-1] 
    66    REAL(wp), PUBLIC               ::  sat_sil             !: saturation concentration for silicate in [mol.l-1] 
    67    REAL(wp), PUBLIC               ::  sat_clay            !: saturation concentration for clay in [mol.l-1] 
     33   REAL(wp), PUBLIC               ::  adsnh4              !: adsorption coefficient of NH4 
     34   REAL(wp), PUBLIC               ::  ratligc             !: C/L ratio in POC 
    6835   REAL(wp), PUBLIC               ::  so2ut  
    6936   REAL(wp), PUBLIC               ::  srno3  
    7037   REAL(wp), PUBLIC               ::  spo4r  
    7138   REAL(wp), PUBLIC               ::  srDnit  
    72    REAL(wp), PUBLIC               ::  sthro2              !: threshold O2 concen. in [mol.l-1] 
    73    REAL(wp), PUBLIC               ::  pdb = 0.0112372     !: 13C/12C in PD Belemnite 
    74    REAL(wp), PUBLIC               ::  rc13P  = 0.980      !: 13C/12C in POC = rc13P*PDB 
    75    REAL(wp), PUBLIC               ::  rc13Ca = 1.001      !: 13C/12C in CaCO3 = rc13Ca*PDB 
    7639   REAL(wp), PUBLIC               ::  dtsed               !: sedimentation time step 
    77    REAL(wp), PUBLIC               ::  db                  !: bioturb coefficient in [cm2.s-1] 
    78  
     40   REAL(wp), PUBLIC               ::  dtsed2              !: sedimentation time step 
    7941   INTEGER , PUBLIC               ::  nitsed000 
    8042   INTEGER , PUBLIC               ::  nitsedend 
    81    INTEGER , PUBLIC               ::  nwrised 
    82    INTEGER , PUBLIC               ::  nfreq 
    83    REAL(wp), PUBLIC               ::  dens                !: density of solid material 
     43   INTEGER, PUBLIC                ::  nrseddt 
     44   REAL    , PUBLIC               ::  sedmask 
     45   REAL(wp), PUBLIC               ::  denssol                !: density of solid material 
     46   INTEGER , PUBLIC               ::  numrsr, numrsw   !: logical unit for sed restart (read and write) 
     47   LOGICAL , PUBLIC               ::  lrst_sed       !: logical to control the trc restart write 
     48   LOGICAL , PUBLIC               ::  ln_rst_sed  = .TRUE.     !: initialisation from a restart file or not 
     49   LOGICAL , PUBLIC               ::  ln_btbz     = .FALSE.    !: Depth variation of the bioturbation coefficient 
     50   LOGICAL , PUBLIC               ::  ln_irrig    = .FALSE.    !: iActivation of the bioirrigation 
     51   LOGICAL , PUBLIC               ::  ln_sed_2way = .FALSE.    !: 2 way coupling with PISCES 
     52   LOGICAL , PUBLIC               ::  ln_sediment_offline = .FALSE. !: Offline mode for sediment module 
     53   INTEGER             , PUBLIC   ::  nn_rstsed      !: control of the time step ( 0 or 1 ) for pass. tr. 
     54   INTEGER , PUBLIC               ::  nn_dtsed = 1   !: frequency of step on passive tracers 
     55   CHARACTER(len = 80) , PUBLIC   ::  cn_sedrst_in   !: suffix of pass. tracer restart name (input) 
     56   CHARACTER(len = 256), PUBLIC   ::  cn_sedrst_indir  !: restart input directory 
     57   CHARACTER(len = 80) , PUBLIC   ::  cn_sedrst_out  !: suffix of pass. tracer restart name (output) 
     58   CHARACTER(len = 256), PUBLIC   ::  cn_sedrst_outdir  !: restart output directory 
     59 
    8460   ! 
    8561   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  pwcp       !: pore water sediment data at given time-step 
     
    8763   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  solcp      !: solid sediment data at given time-step 
    8864   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  solcp0     !: solid sediment data at initial time 
     65   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  trc_dta 
     66   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  diff 
    8967 
    9068   !! * Shared module variables 
     
    10280   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  press      !: pressure 
    10381   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  raintg     !: total massic flux rained in each cell (sum of sol. comp.) 
     82   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  fecratio   !: Fe/C ratio in falling particles to the sediments 
    10483   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  dzdep      !: total thickness of solid material rained [cm] in each cell 
     84   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  zkbot      !: total thickness of solid material rained [cm] in each cell 
     85   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  wacc       !: total thickness of solid material rained [cm] in each cell 
    10586   ! 
    10687   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  hipor      !: [h+] in mol/kg*densSW  
     
    127108   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  aksis  
    128109   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  aksps  
     110   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  sieqs 
     111   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  aks3s 
     112   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  akf3s 
     113   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  sulfats 
     114   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  fluorids 
    129115 
    130116   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  mol_wgt    !: molecular weight of solid sediment data 
     
    133119   !! Geometry 
    134120   INTEGER , PUBLIC, SAVE                          ::  jpoce, indoce !: Ocean points ( number/indices ) 
    135    REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  iarroce       !: Computation of 1D array of sediments points 
     121   INTEGER , PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  iarroce       !: Computation of 1D array of sediments points 
    136122   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  epkbot        !: ocean bottom layer thickness 
     123   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  gdepbot       !: Depth of the sediment 
    137124   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  dzkbot        !: ocean bottom layer thickness in meters 
    138    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  tmasksed      !: sediment mask 
    139    REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  sbathy        !: bathymetry 
    140125   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  dz            !: sediment layers thickness 
    141126   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  por           !: porosity profile      
    142127   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  por1          !: 1-por  
    143    REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  profsed       !: depth of middle of each layer 
    144128   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  volw          !: volume of pore water cell fraction 
    145129   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  vols          !: volume of solid cell fraction 
    146    REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  diff          !: diffusion ceofficient 
     130   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  db            !: bioturbation ceofficient 
     131   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE ::  irrig        !: bioturbation ceofficient 
    147132   REAL(wp), PUBLIC, DIMENSION(:    ), ALLOCATABLE ::  rdtsed        !:  sediment model time-step 
     133   REAL(wp), PUBLIC, DIMENSION(:,:  ), ALLOCATABLE :: sedligand 
    148134   REAL(wp)  ::   dens               !: density of solid material 
    149135   !! Inputs / Outputs 
     
    171157      !!------------------------------------------------------------------- 
    172158      ! 
    173       ALLOCATE( trc_dta(jpi,jpj,jdta)                                     ,   & 
    174          &      epkbot(jpi,jpj), sbathy(jpi,jpj)                          ,   & 
    175          &      tmasksed(jpi,jpj,jpksed)                                  ,   & 
    176          &      dz(jpksed)  , por(jpksed) , por1(jpksed), profsed(jpksed) ,   & 
    177          &      volw(jpksed), vols(jpksed), diff(jpksed), rdtsed(jpksed)  ,   & 
     159      ALLOCATE( trc_data(jpi,jpj,jpdta)                                   ,   & 
     160         &      epkbot(jpi,jpj), gdepbot(jpi,jpj)        ,   & 
     161         &      dz(jpksed)  , por(jpksed) , por1(jpksed)                  ,   & 
     162         &      volw(jpksed), vols(jpksed), rdtsed(jpksed)  ,   & 
    178163         &      trcsedi  (jpi,jpj,jpksed,jptrased)                        ,   & 
    179164         &      flxsedi3d(jpi,jpj,jpksed,jpdia3dsed)                      ,   & 
    180          &      flxsedi2d(jpi,jpj,jpksed,jpdia2dsed)                      ,   & 
     165         &      flxsedi2d(jpi,jpj,jpdia2dsed)                             ,   & 
    181166         &      mol_wgt(jpsol),                                           STAT=sed_alloc ) 
    182167 
     
    185170   END FUNCTION sed_alloc 
    186171 
    187 #else 
    188    !!====================================================================== 
    189    !! No Sediment model 
    190    !!====================================================================== 
    191 #endif 
    192  
    193172END MODULE sed 
  • NEMO/trunk/src/TOP/PISCES/SED/sedadv.F90

    r9124 r10222  
    44   !!    Sediment : vertical advection and burial 
    55   !!===================================================================== 
    6 #if defined key_sed 
    7    !!---------------------------------------------------------------------- 
    8    !!   'key_sed'                                                  Sediment  
     6   !! * Modules used 
    97   !!---------------------------------------------------------------------- 
    108   !!   sed_adv : 
    119   !!---------------------------------------------------------------------- 
    1210   USE sed     ! sediment global variable 
     11   USE lib_mpp         ! distribued memory computing library 
     12 
     13   IMPLICIT NONE 
     14   PRIVATE 
    1315 
    1416   PUBLIC sed_adv 
    15  
    16    !! * Module variable 
    17    INTEGER, PARAMETER  ::  nztime = jpksed         ! number of time step between sunrise and sunset 
    18  
    19    REAL(wp), DIMENSION(jpksed), SAVE :: dvolsp, dvolsm 
    20    REAL(wp), DIMENSION(jpksed), SAVE :: c2por, ckpor 
     17   PUBLIC sed_adv_alloc 
     18 
     19   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: dvolsp, dvolsm 
     20   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: c2por, ckpor 
    2121 
    2222   REAL(wp) :: cpor 
     
    4949      ! * local variables 
    5050      INTEGER :: ji, jk, js  
    51       INTEGER :: jn, ntimes, ikwneg 
     51      INTEGER :: jn, ntimes, nztime, ikwneg 
    5252       
    53       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsolcpno 
    54       REAL(wp), DIMENSION(:  ), ALLOCATABLE :: zfilled, zfull, zfromup, zempty 
    55       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zgap, zwb 
    56       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zrainrf 
    57       REAL(wp), DIMENSION(nztime) :: zraipush 
    58  
    59       REAL(wp) :: zkwnup, zkwnlo, zfrac,  zfromce, zrest 
     53      REAL(wp), DIMENSION(jpksed,jpsol) :: zsolcpno 
     54      REAL(wp), DIMENSION(jpksed)      :: zfilled, zfull, zfromup, zempty 
     55      REAL(wp), DIMENSION(jpoce,jpksed) :: zgap, zwb 
     56      REAL(wp), DIMENSION(jpoce,jpsol) :: zrainrf 
     57      REAL(wp), DIMENSION(:  ), ALLOCATABLE :: zraipush 
     58 
     59      REAL(wp) :: zkwnup, zkwnlo, zfrac,  zfromce, zrest, sumtot, zsumtot1 
    6060 
    6161      !------------------------------------------------------------------------ 
    6262 
    6363 
     64      IF( ln_timing )  CALL timing_start('sed_adv') 
     65! 
    6466      IF( kt == nitsed000 ) THEN 
    65          WRITE(numsed,*) ' ' 
    66          WRITE(numsed,*) ' sed_adv : vertical sediment advection  ' 
    67          WRITE(numsed,*) ' ' 
    68          por1clay = dens * por1(jpksed) * dz(jpksed) / mol_wgt(jsclay) 
     67         IF (lwp) THEN 
     68            WRITE(numsed,*) ' ' 
     69            WRITE(numsed,*) ' sed_adv : vertical sediment advection  ' 
     70            WRITE(numsed,*) ' ' 
     71         ENDIF 
     72         por1clay = denssol * por1(jpksed) * dz(jpksed) 
    6973         cpor     = por1(jpksed) / por1(2) 
    7074         DO jk = 2, jpksed 
     
    8084      ENDIF 
    8185 
    82       ALLOCATE( zsolcpno(jpksed,jpsol), zrainrf(jpoce,jpsol) ) 
    83       ALLOCATE( zfilled(jpksed), zfull(jpksed), zfromup(jpksed), zempty(jpksed) ) 
    84       ALLOCATE( zgap (jpoce,jpksed)   , zwb(jpoce,jpksed)  )   
    85  
    8686      ! Initialization of data for mass balance calculation 
    8787      !--------------------------------------------------- 
     
    8989      tosed  (:,:) = 0.  
    9090      rloss  (:,:) = 0. 
    91  
     91      ikwneg = 1 
     92      nztime = jpksed 
     93 
     94      ALLOCATE( zraipush(nztime) ) 
    9295 
    9396      ! Initiate gap  
     
    104107      zgap(1:jpoce,1:jpksed) = 1. - zgap(1:jpoce,1:jpksed)    
    105108 
    106  
    107109      ! Initiate burial rates 
    108110      !----------------------- 
    109111      zwb(:,:) = 0. 
    110112      DO jk = 2, jpksed 
    111          zfrac =  dtsed / ( dens * por1(jk) )      
     113         zfrac =  dtsed / ( denssol * por1(jk) )      
    112114         DO ji = 1, jpoce 
    113115            zwb(ji,jk) = zfrac * raintg(ji) 
     
    127129      ENDDO 
    128130 
    129  
    130131      zrainrf(:,:) = 0. 
    131132      DO ji = 1, jpoce 
     
    206207                  ! quantities to push in deeper sediment 
    207208                  tosed  (ji,js) = zsolcpno(jpksed,js) & 
    208                      &           * zwb(ji,jpksed) * dens * por1(jpksed) / mol_wgt(js) 
    209                ENDDO 
    210                 
     209                     &           * zwb(ji,jpksed) * denssol * por1(jpksed) 
     210               ENDDO 
     211 
    211212            ELSE ! what is remaining is great than dz(2) 
    212213 
    213214               ntimes = INT( zrest / dz(2) ) + 1 
    214                IF( ntimes > nztime ) THEN 
    215                   WRITE( numsed,* ) ' sedadv : rest too large at sediment point ji = ', ji 
    216                   STOP 
    217                ENDIF 
     215               IF( ntimes > nztime ) CALL ctl_stop( 'STOP', 'sed_adv : rest too large ' ) 
    218216               zraipush(1) = dz(2) 
    219217               zrest = zrest - zraipush(1) 
     
    249247                     fromsed(ji,js) = 0. 
    250248                     tosed  (ji,js) = tosed(ji,js) + zsolcpno(jpksed,js) * zraipush(jn) & 
    251                         &             * dens * por1(2) / mol_wgt(js) 
     249                        &             * denssol * por1(2)  
    252250                  ENDDO 
    253251               ENDDO 
     
    279277            ! for the last layer, one make go up clay  
    280278            solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1. 
    281             !! C. Heinze      fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay) 
    282279            fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 
    283  
    284280         ELSE  ! rain > 0 and rain < total reaction loss 
    285281 
     
    323319               ENDDO 
    324320               solcp(ji,jpksed,jsclay) =  solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1. 
    325                !! C. Heinze  fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay) 
     321               !! C. Heinze  fromsed(ji,jsclay) = zempty(jpksed) * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 
    326322               fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 
    327323                
     
    339335                  solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js) 
    340336               ENDDO 
    341                DO  js = 1, jpsol               
     337               DO  js = 1, jpsol 
    342338                  DO jk = jpksedm1, 3, -1 
    343339                     solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk-1,js) 
     
    349345               ENDDO 
    350346               solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zkwnlo * 1. 
    351                ! Heinze  fromsed(ji,jsclay) = zkwnlo * 1. * dens * por1(jpksed) / mol_wgt(jsclay) 
     347               ! Heinze  fromsed(ji,jsclay) = zkwnlo * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 
    352348               fromsed(ji,jsclay) = zkwnlo * 1.* por1clay 
    353349            ELSE   ! 2 < ikwneg(ji) <= jpksedm1 
     
    415411                  fromsed(ji,js)   = 0. 
    416412               ENDDO 
    417                ! Heinze  fromsed(ji,jsclay) = zempty * 1. * dens * por1(jpksed) / mol_wgt(jsclay) 
     413               ! Heinze  fromsed(ji,jsclay) = zempty * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 
    418414               fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 
     415 
    419416            ENDIF ! ikwneg(ji) = 2 
    420417         ENDIF  ! zwb > 0 
     
    425422      raintg(:)   = 0. 
    426423 
    427       DEALLOCATE( zsolcpno )    
    428       DEALLOCATE( zrainrf  ) 
    429       DEALLOCATE( zfilled  ) 
    430       DEALLOCATE( zfull    ) 
    431       DEALLOCATE( zfromup  ) 
    432       DEALLOCATE( zempty   ) 
    433       DEALLOCATE( zgap     )   
    434       DEALLOCATE( zwb      ) 
    435  
     424      DEALLOCATE( zraipush ) 
     425 
     426      IF( ln_timing )  CALL timing_stop('sed_adv') 
    436427 
    437428   END SUBROUTINE sed_adv 
    438 #else 
    439    !!====================================================================== 
    440    !! MODULE sedbtb  :   Dummy module  
    441    !!====================================================================== 
    442    !! $Id$ 
    443 CONTAINS 
    444    SUBROUTINE sed_adv( kt )         ! Empty routine 
    445       INTEGER, INTENT(in) :: kt 
    446       WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt 
    447    END SUBROUTINE sed_adv 
    448  
    449    !!====================================================================== 
    450  
    451 #endif 
     429 
     430 
     431   INTEGER FUNCTION sed_adv_alloc() 
     432      !!---------------------------------------------------------------------- 
     433      !!                     ***  ROUTINE p4z_prod_alloc  *** 
     434      !!---------------------------------------------------------------------- 
     435      ALLOCATE( dvolsp(jpksed), dvolsm(jpksed), c2por(jpksed),         & 
     436      &         ckpor(jpksed) ,           STAT = sed_adv_alloc ) 
     437      ! 
     438      IF( sed_adv_alloc /= 0 ) CALL ctl_warn('sed_adv_alloc : failed to allocate arrays.') 
     439      ! 
     440   END FUNCTION sed_adv_alloc 
     441 
    452442END MODULE sedadv 
  • NEMO/trunk/src/TOP/PISCES/SED/sedarr.F90

    r10068 r10222  
    44   !!              transform 1D (2D) array to a 2D (1D) table 
    55   !!====================================================================== 
    6 #if defined key_sed 
     6 
    77   !!---------------------------------------------------------------------- 
    88   !!   arr_2d_1d  : 2-D to 1-D 
     
    1111   !! * Modules used 
    1212   USE par_sed 
     13   USE dom_oce 
     14   USE sed 
    1315 
    1416   IMPLICIT NONE 
     
    2830 
    2931   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     32   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3133   !! $Id$  
    32    !! Software governed by the CeCILL license (see ./LICENSE) 
     34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3335   !!---------------------------------------------------------------------- 
    3436CONTAINS 
     
    4244 
    4345      INTEGER ::  jn, jid, jjd 
     46 
     47      IF( ln_timing )   CALL timing_start('pack_arr_2d_1d') 
    4448         
    4549      DO jn = 1, ndim1d 
     
    4852         tab1d(jn)  = tab2d(jid, jjd) 
    4953      END DO  
     54 
     55      IF( ln_timing )   CALL timing_stop('pack_arr_2d_1d') 
    5056 
    5157   END SUBROUTINE pack_arr_2d_1d 
     
    5965      INTEGER ::  jn, jid, jjd 
    6066 
     67      IF( ln_timing )   CALL timing_start('unpack_arr_1d_2d') 
     68 
    6169      DO jn = 1, ndim1d 
    6270         jid             = MOD( tab_ind(jn) - 1, jpi) + 1 
     
    6472         tab2d(jid, jjd) = tab1d(jn) 
    6573      END DO 
     74 
     75      IF( ln_timing )   CALL timing_stop('unpack_arr_1d_2d') 
    6676 
    6777   END SUBROUTINE unpack_arr_1d_2d 
     
    7585      INTEGER, DIMENSION(ndim1d) ::  jid, jjd         
    7686      INTEGER ::    jk, jn , ji, jj 
     87 
     88      IF( ln_timing )   CALL timing_start('pack_arr_2d_3d') 
    7789       
    7890      DO jn = 1, ndim1d 
     
    88100         ENDDO 
    89101      ENDDO 
     102 
     103      IF( ln_timing )   CALL timing_stop('pack_arr_2d_3d') 
    90104       
    91105   END SUBROUTINE pack_arr_3d_2d 
     
    100114      INTEGER, DIMENSION(ndim1d) ::  jid, jjd         
    101115      INTEGER ::   jk, jn , ji, jj 
    102  
    103      DO jn = 1, ndim1d 
     116      ! 
     117      IF( ln_timing )   CALL timing_start('unpack_arr_2d_3d') 
     118      ! 
     119      DO jn = 1, ndim1d 
    104120         jid(jn) = MOD( tab_ind(jn) - 1, jpi ) + 1 
    105121         jjd(jn) = ( tab_ind(jn) - 1 ) / jpi + 1 
     
    114130      ENDDO 
    115131 
     132      IF( ln_timing )   CALL timing_stop('unpack_arr_2d_3d') 
     133 
    116134   END SUBROUTINE unpack_arr_2d_3d 
    117135 
    118 #else 
    119    !!====================================================================== 
    120    !! MODULE sedarr  :   Dummy module 
    121    !!====================================================================== 
    122 CONTAINS 
    123    SUBROUTINE pack_arr         ! Empty routine 
    124    END SUBROUTINE  pack_arr 
    125    SUBROUTINE unpack_arr         ! Empty routine 
    126    END SUBROUTINE  unpack_arr 
    127    !!====================================================================== 
    128 #endif 
    129136END MODULE sedarr 
  • NEMO/trunk/src/TOP/PISCES/SED/sedbtb.F90

    r5215 r10222  
    11MODULE sedbtb 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!              ***  MODULE  sedbtb  *** 
     
    87   USE sed     ! sediment global variable 
    98   USE sedmat  ! linear system of equations 
     9   USE lib_mpp         ! distribued memory computing library 
     10 
     11   IMPLICIT NONE 
     12   PRIVATE 
    1013 
    1114   PUBLIC sed_btb 
     
    3336      ! * local variables 
    3437      INTEGER :: ji, jk, js 
    35       REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE ::  zsol  !   solution 
     38      REAL(wp), DIMENSION(jpoce,jpksedm1,jpsol) ::  zsol  !   solution 
    3639      !------------------------------------------------------------------------ 
    3740 
     41      IF( ln_timing )  CALL timing_start('sed_btb') 
     42 
    3843      IF( kt == nitsed000 ) THEN 
    39          WRITE(numsed,*) ' sed_btb : Bioturbation  ' 
    40          WRITE(numsed,*) ' ' 
     44         IF (lwp) WRITE(numsed,*) ' sed_btb : Bioturbation  ' 
     45         IF (lwp) WRITE(numsed,*) ' ' 
    4146      ENDIF 
    4247 
    4348      ! Initializations 
    4449      !---------------- 
    45       ALLOCATE( zsol(jpoce,jpksedm1,jpsol) ) 
    46  
    4750      zsol(:,:,:) = 0. 
    48  
    4951 
    5052      ! right hand side of coefficient matrix 
     
    5860      ENDDO 
    5961 
    60       CALL sed_mat( jpsol, jpoce, jpksedm1, zsol ) 
     62      CALL sed_mat( jpsol, jpoce, jpksedm1, zsol, dtsed / 2.0 ) 
    6163 
    6264 
     
    7072         ENDDO 
    7173      ENDDO 
    72       
    73       DEALLOCATE( zsol ) 
     74 
     75      IF( ln_timing )  CALL timing_stop('sed_btb') 
    7476 
    7577   END SUBROUTINE sed_btb 
    76 #else 
    77    !!====================================================================== 
    78    !! MODULE sedbtb  :   Dummy module  
    79    !!====================================================================== 
    80    !! $Id$ 
    81 CONTAINS 
    82    SUBROUTINE sed_btb( kt )         ! Empty routine 
    83       INTEGER, INTENT(in) :: kt 
    84       WRITE(*,*) 'sed_btb: You should not have seen this print! error?', kt 
    85    END SUBROUTINE sed_btb 
    8678 
    87    !!====================================================================== 
    88  
    89 #endif 
    9079END MODULE sedbtb 
  • NEMO/trunk/src/TOP/PISCES/SED/sedchem.F90

    r5215 r10222  
    11MODULE sedchem 
    22 
    3 #if defined key_sed  
    43   !!====================================================================== 
    54   !!                        ***  Module sedchem  *** 
     
    98   USE sed     ! sediment global variable 
    109   USE sedarr 
     10   USE eosbn2, ONLY : neos 
     11   USE lib_mpp         ! distribued memory computing library 
     12 
     13   IMPLICIT NONE 
     14   PRIVATE 
    1115 
    1216   !! * Accessibility 
    13    PUBLIC sed_chem    
     17   PUBLIC sed_chem 
     18   PUBLIC ahini_for_at_sed     ! 
     19   PUBLIC solve_at_general_sed ! 
     20 
     21   ! Maximum number of iterations for each method 
     22   INTEGER, PARAMETER :: jp_maxniter_atgen    = 20 
     23   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 
    1424 
    1525   !! * Module variables 
    1626   REAL(wp) :: & 
    17       salchl = 1./1.80655 , & ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    1827      calcon = 1.03E-2        ! mean calcite concentration [Ca2+] in sea water [mole/kg solution]  
    1928 
    20    REAL(wp) :: &              ! coeff. for 1. dissoc. of carbonic acid (Millero, 1995)    
    21       c10 = 3670.7   , & 
    22       c11 = 62.008   , & 
    23       c12 = 9.7944   , & 
    24       c13 = 0.0118   , & 
    25       c14 = 0.000116 
    26  
    27    REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
    28       c20 = 1394.7   , & 
    29       c21 = 4.777    , & 
    30       c22 = 0.       , & 
    31       c23 = 0.0184   , & 
    32       c24 = 0.000118 
    33  
    34    REAL(wp) :: &              ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 
    35       cb0  = -8966.90, & 
    36       cb1  = -2890.53, & 
    37       cb2  = -77.942 , & 
    38       cb3  = 1.728   , & 
    39       cb4  = -0.0996 , & 
    40       cb5  = 148.0248, & 
    41       cb6  = 137.1942, & 
    42       cb7  = 1.62142 , & 
    43       cb8  = -24.4344, & 
    44       cb9  = -25.085 , & 
    45       cb10 = -0.2474 , & 
    46       cb11 = 0.053105 
    47  
    48    REAL(wp) :: &             ! borat constants 
    49       bor1 = 0.000232, & 
    50       bor2 = 1./10.811 
    51  
    52    REAL(wp) :: &             ! constants for calculate concentrations  
    53       st1  = 0.14     , &    ! for sulfate (Morris & Riley 1966) 
    54       st2  = 1./96.062, & 
    55       ks0  = 141.328  , & 
    56       ks1  = -4276.1  , & 
    57       ks2  = -23.093  , & 
    58       ks3  = -13856.  , & 
    59       ks4  = 324.57   , & 
    60       ks5  = -47.986  , & 
    61       ks6  = 35474.   , & 
    62       ks7  = -771.54  , & 
    63       ks8  = 114.723  , & 
    64       ks9  = -2698.   , & 
    65       ks10 = 1776.    , & 
    66       ks11 = 1.       , & 
    67       ks12 = -0.001005  
    68  
    69    REAL(wp) :: &             ! constants for calculate concentrations  
    70       ft1  = 0.000067   , &  ! fluorides (Dickson & Riley 1979 ) 
    71       ft2  = 1./18.9984 , & 
    72       kf0  = -12.641    , & 
    73       kf1  = 1590.2     , & 
    74       kf2  = 1.525      , & 
    75       kf3  = 1.0        , & 
    76       kf4  =-0.001005 
    77  
    78    REAL(wp) :: &             ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 
    79       cw0 = -13847.26  , & 
    80       cw1 = 148.9802   , & 
    81       cw2 = -23.6521   , & 
    82       cw3 = 118.67     , & 
    83       cw4 = -5.977     , & 
    84       cw5 = 1.0495     , & 
    85       cw6 = -0.01615 
    86   
    87    REAL(wp) :: &             ! coeff. for dissoc. of phosphate (Millero (1974) 
    88       cp10 = 115.54    , & 
    89       cp11 = -4576.752 , & 
    90       cp12 = -18.453   , & 
    91       cp13 = -106.736  , & 
    92       cp14 = 0.69171   , & 
    93       cp15 = -0.65643  , & 
    94       cp16 = -0.01844  , & 
    95       cp20 = 172.1033  , & 
    96       cp21 = -8814.715 , & 
    97       cp22 = -27.927   , & 
    98       cp23 = -160.340  , & 
    99       cp24 = 1.3566    , & 
    100       cp25 = 0.37335   , & 
    101       cp26 = -0.05778  , & 
    102       cp30 = -18.126   , & 
    103       cp31 = -3070.75  , & 
    104       cp32 = 17.27039  , & 
    105       cp33 = 2.81197   , & 
    106       cp34 = -44.99486 , & 
    107       cp35 = -0.09984 
    108  
    109    REAL(wp) :: &             ! coeff. for dissoc. of silicates (Millero (1974)   
    110       cs10 = 117.40    , &   
    111       cs11 = -8904.2   , &  
    112       cs12 = -19.334   , &  
    113       cs13 = -458.79   , &  
    114       cs14 = 3.5913    , &  
    115       cs15 = 188.74    , &  
    116       cs16 = -1.5998   , &  
    117       cs17 = -12.1652  , &  
    118       cs18 = 0.07871   , &  
    119       cs19 = 0.        , &  
    120       cs20 = 1.        , &  
    121       cs21 = -0.001005 
    122  
    123    REAL(wp) :: &            ! coeff. for apparent solubility equilibrium  
    124       ! akcc1 = -34.452 , & ! of calcite (Ingle,1975,  1800, eq. 6) 
    125       ! akcc2 = -39.866 , &   
    126       ! akcc3 = 110.21  , &   
    127       ! akcc4 = -7.5752E-6   
    128       akcc1 = -171.9065 , &    ! Millero et al. 1995 from Mucci 1983 
    129       akcc2 = -0.077993 , &   
    130       akcc3 = 2839.319  , &   
    131       akcc4 = 71.595    , &   
    132       akcc5 = -0.77712  , &   
    133       akcc6 = 0.0028426 , &   
    134       akcc7 = 178.34    , &   
    135       akcc8 = -0.07711  , &   
    136       akcc9 = 0.0041249 
    137  
    138    REAL(wp) :: &                 ! universal gas constant 
    139       rgas = 83.145              ! bar.cm3/(mol.K) or R=8.31451 J/(g.mol.K) 
    140  
    141  
    142    ! coeff. for seawater pressure correction (millero 95)       
    143    REAL(wp), DIMENSION(8)  :: &  
    144       devk1, devk2, devk3, devk4, devk5 
    145  
    146    DATA devk1/ -25.5   , -15.82    , -29.48  , -25.60    , -48.76    , -14.51   , -23.12   , -26.57   /    
    147    DATA devk2/ 0.1271  , -0.0219   , 0.1622  , 0.2324    , -0.5304   , 0.1211   ,  0.1758  , 0.2020   /    
    148    DATA devk3/ 0.      , 0.        , 2.608E-3, -3.6246E-3, 0.        , -0.321E-3, -2.647E-3, -3.042E-3/    
    149    DATA devk4/-3.08E-3 , 1.13E-3   , -2.84E-3, -5.13E-3  , -11.76E-3 , -2.67E-3 , -5.15E-3 , -4.08E-3 /    
    150    DATA devk5/0.0877E-3, -0.1475E-3, 0.      , 0.0794E-3 , -0.3692E-3, 0.0427E-3,  0.09E-3 , 0.0714E-3/ 
    151  
     29   REAL(wp) ::   rgas   = 83.14472      ! universal gas constants 
    15230 
    15331   ! coeff. for density of sea water (Millero & Poisson 1981)  
     
    16240   REAL(wp), DIMENSION(6)  :: Ddsw                     
    16341   DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/ 
     42 
     43  REAL(wp) :: devk10  = -25.5 
     44   REAL(wp) :: devk11  = -15.82 
     45   REAL(wp) :: devk12  = -29.48 
     46   REAL(wp) :: devk13  = -20.02 
     47   REAL(wp) :: devk14  = -18.03 
     48   REAL(wp) :: devk15  = -9.78 
     49   REAL(wp) :: devk16  = -48.76 
     50   REAL(wp) :: devk17  = -14.51 
     51   REAL(wp) :: devk18  = -23.12 
     52   REAL(wp) :: devk19  = -26.57 
     53   REAL(wp) :: devk110  = -29.48 
     54   ! 
     55   REAL(wp) :: devk20  = 0.1271 
     56   REAL(wp) :: devk21  = -0.0219 
     57   REAL(wp) :: devk22  = 0.1622 
     58   REAL(wp) :: devk23  = 0.1119 
     59   REAL(wp) :: devk24  = 0.0466 
     60   REAL(wp) :: devk25  = -0.0090 
     61   REAL(wp) :: devk26  = 0.5304 
     62   REAL(wp) :: devk27  = 0.1211 
     63   REAL(wp) :: devk28  = 0.1758 
     64   REAL(wp) :: devk29  = 0.2020 
     65   REAL(wp) :: devk210  = 0.1622 
     66   ! 
     67   REAL(wp) :: devk30  = 0. 
     68   REAL(wp) :: devk31  = 0. 
     69   REAL(wp) :: devk32  = 2.608E-3 
     70   REAL(wp) :: devk33  = -1.409e-3 
     71   REAL(wp) :: devk34  = 0.316e-3 
     72   REAL(wp) :: devk35  = -0.942e-3 
     73   REAL(wp) :: devk36  = 0. 
     74   REAL(wp) :: devk37  = -0.321e-3 
     75   REAL(wp) :: devk38  = -2.647e-3 
     76   REAL(wp) :: devk39  = -3.042e-3 
     77   REAL(wp) :: devk310  = -2.6080e-3 
     78   ! 
     79   REAL(wp) :: devk40  = -3.08E-3 
     80   REAL(wp) :: devk41  = 1.13E-3 
     81   REAL(wp) :: devk42  = -2.84E-3 
     82   REAL(wp) :: devk43  = -5.13E-3 
     83   REAL(wp) :: devk44  = -4.53e-3 
     84   REAL(wp) :: devk45  = -3.91e-3 
     85   REAL(wp) :: devk46  = -11.76e-3 
     86   REAL(wp) :: devk47  = -2.67e-3 
     87   REAL(wp) :: devk48  = -5.15e-3 
     88   REAL(wp) :: devk49  = -4.08e-3 
     89   REAL(wp) :: devk410  = -2.84e-3 
     90   ! 
     91   REAL(wp) :: devk50  = 0.0877E-3 
     92   REAL(wp) :: devk51  = -0.1475E-3 
     93   REAL(wp) :: devk52  = 0. 
     94   REAL(wp) :: devk53  = 0.0794E-3 
     95   REAL(wp) :: devk54  = 0.09e-3 
     96   REAL(wp) :: devk55  = 0.054e-3 
     97   REAL(wp) :: devk56  = 0.3692E-3 
     98   REAL(wp) :: devk57  = 0.0427e-3 
     99   REAL(wp) :: devk58  = 0.09e-3 
     100   REAL(wp) :: devk59  = 0.0714e-3 
     101   REAL(wp) :: devk510  = 0.0 
    164102 
    165103   !! $Id$ 
     
    179117      INTEGER, INTENT(in) :: kt                     ! time step 
    180118 
    181 #if ! defined key_sed_off 
    182119      INTEGER  :: ji, jj, ikt 
    183       REAL(wp) :: ztkel, ztc, ztc2, zpres, ztr  
    184       REAL(wp) :: zsal, zsal2, zsqrt, zsal15   
    185       REAL(wp) :: zis, zis2, zisqrt           
     120      REAL(wp) :: ztc, ztc2 
     121      REAL(wp) :: zsal, zsal15   
    186122      REAL(wp) :: zdens0, zaw, zbw, zcw     
    187       REAL(wp) :: zbuf1, zbuf2  
    188       REAL(wp) :: zcpexp, zcpexp2 
    189       REAL(wp) :: zck1p, zck2p, zck3p, zcksi    
    190       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zchem_data 
    191  
    192 #endif 
     123      REAL(wp), DIMENSION(jpi,jpj,15) ::   zchem_data 
    193124      !!---------------------------------------------------------------------- 
    194125 
    195       IF( MOD( kt - 1, nfreq ) /= 0 ) RETURN 
    196  
    197       WRITE(numsed,*) ' Getting Chemical constants from tracer model at time kt = ', kt 
    198       WRITE(numsed,*) ' ' 
    199  
    200  
    201 #if defined key_sed_off 
    202       CALL sed_chem_off 
    203 #else 
     126 
     127      IF( ln_timing )  CALL timing_start('sed_chem') 
     128 
     129      IF (lwp) WRITE(numsed,*) ' Getting Chemical constants from tracer model at time kt = ', kt 
     130      IF (lwp) WRITE(numsed,*) ' ' 
     131 
    204132      ! reading variables 
    205       ALLOCATE( zchem_data(jpi,jpj,6) )   ;   zchem_data(:,:,:) = 0. 
    206  
    207       DO jj = 1,jpj 
    208          DO ji = 1, jpi 
    209             ikt = mbkt(ji,jj)  
    210             IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    211                zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 
    212                zchem_data(ji,jj,2) = ak23 (ji,jj,ikt) 
    213                zchem_data(ji,jj,3) = akb3 (ji,jj,ikt) 
    214                zchem_data(ji,jj,4) = akw3 (ji,jj,ikt) 
    215                zchem_data(ji,jj,5) = aksp (ji,jj,ikt) 
    216                zchem_data(ji,jj,6) = borat(ji,jj,ikt) 
    217             ENDIF 
     133      zchem_data(:,:,:) = rtrn 
     134 
     135      IF (ln_sediment_offline) THEN 
     136         CALL sed_chem_cst 
     137      ELSE 
     138         DO jj = 1,jpj 
     139            DO ji = 1, jpi 
     140               ikt = mbkt(ji,jj)  
     141               IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     142                  zchem_data(ji,jj,1) = ak13  (ji,jj,ikt) 
     143                  zchem_data(ji,jj,2) = ak23  (ji,jj,ikt) 
     144                  zchem_data(ji,jj,3) = akb3  (ji,jj,ikt) 
     145                  zchem_data(ji,jj,4) = akw3  (ji,jj,ikt) 
     146                  zchem_data(ji,jj,5) = aksp  (ji,jj,ikt) 
     147                  zchem_data(ji,jj,6) = borat (ji,jj,ikt) 
     148                  zchem_data(ji,jj,7) = ak1p3 (ji,jj,ikt) 
     149                  zchem_data(ji,jj,8) = ak2p3 (ji,jj,ikt) 
     150                  zchem_data(ji,jj,9) = ak3p3 (ji,jj,ikt) 
     151                  zchem_data(ji,jj,10)= aksi3 (ji,jj,ikt) 
     152                  zchem_data(ji,jj,11)= sio3eq(ji,jj,ikt) 
     153                  zchem_data(ji,jj,12)= aks3  (ji,jj,ikt) 
     154                  zchem_data(ji,jj,13)= akf3  (ji,jj,ikt) 
     155                  zchem_data(ji,jj,14)= sulfat(ji,jj,ikt) 
     156                  zchem_data(ji,jj,15)= fluorid(ji,jj,ikt) 
     157               ENDIF 
     158            ENDDO 
    218159         ENDDO 
    219       ENDDO 
    220  
    221       CALL pack_arr ( jpoce, ak1s  (1:jpoce), zchem_data(1:jpi,1:jpj,1), iarroce(1:jpoce) ) 
    222       CALL pack_arr ( jpoce, ak2s  (1:jpoce), zchem_data(1:jpi,1:jpj,2), iarroce(1:jpoce) ) 
    223       CALL pack_arr ( jpoce, akbs  (1:jpoce), zchem_data(1:jpi,1:jpj,3), iarroce(1:jpoce) ) 
    224       CALL pack_arr ( jpoce, akws  (1:jpoce), zchem_data(1:jpi,1:jpj,4), iarroce(1:jpoce) ) 
    225       CALL pack_arr ( jpoce, aksps (1:jpoce), zchem_data(1:jpi,1:jpj,5), iarroce(1:jpoce) ) 
    226       CALL pack_arr ( jpoce, borats(1:jpoce), zchem_data(1:jpi,1:jpj,6), iarroce(1:jpoce) ) 
    227  
    228       DEALLOCATE( zchem_data ) 
     160 
     161         CALL pack_arr ( jpoce, ak1s  (1:jpoce), zchem_data(1:jpi,1:jpj,1) , iarroce(1:jpoce) ) 
     162         CALL pack_arr ( jpoce, ak2s  (1:jpoce), zchem_data(1:jpi,1:jpj,2) , iarroce(1:jpoce) ) 
     163         CALL pack_arr ( jpoce, akbs  (1:jpoce), zchem_data(1:jpi,1:jpj,3) , iarroce(1:jpoce) ) 
     164         CALL pack_arr ( jpoce, akws  (1:jpoce), zchem_data(1:jpi,1:jpj,4) , iarroce(1:jpoce) ) 
     165         CALL pack_arr ( jpoce, aksps (1:jpoce), zchem_data(1:jpi,1:jpj,5) , iarroce(1:jpoce) ) 
     166         CALL pack_arr ( jpoce, borats(1:jpoce), zchem_data(1:jpi,1:jpj,6) , iarroce(1:jpoce) ) 
     167         CALL pack_arr ( jpoce, ak1ps (1:jpoce), zchem_data(1:jpi,1:jpj,7) , iarroce(1:jpoce) ) 
     168         CALL pack_arr ( jpoce, ak2ps (1:jpoce), zchem_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) ) 
     169         CALL pack_arr ( jpoce, ak3ps (1:jpoce), zchem_data(1:jpi,1:jpj,9) , iarroce(1:jpoce) ) 
     170         CALL pack_arr ( jpoce, aksis (1:jpoce), zchem_data(1:jpi,1:jpj,10), iarroce(1:jpoce) ) 
     171         CALL pack_arr ( jpoce, sieqs (1:jpoce), zchem_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 
     172         CALL pack_arr ( jpoce, aks3s (1:jpoce), zchem_data(1:jpi,1:jpj,12), iarroce(1:jpoce) ) 
     173         CALL pack_arr ( jpoce, akf3s (1:jpoce), zchem_data(1:jpi,1:jpj,13), iarroce(1:jpoce) ) 
     174         CALL pack_arr ( jpoce, sulfats(1:jpoce), zchem_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 
     175         CALL pack_arr ( jpoce, fluorids(1:jpoce), zchem_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 
     176      ENDIF 
    229177 
    230178      DO ji = 1, jpoce 
    231          ztkel   = temp(ji) + 273.16 
    232179         ztc     = temp(ji) 
    233180         ztc2    = ztc * ztc 
    234          zpres   = press(ji) 
    235181         ! zqtt    = ztkel * 0.01 
    236182         zsal    = salt(ji) 
    237          zsal2   = zsal * zsal  
    238          zsqrt   = SQRT( zsal ) 
    239          zsal15  = zsqrt * zsal 
    240          zlogt   = LOG( ztkel ) 
    241          ztr     = 1./ ztkel 
    242          ! zis=ionic strength (ORNL/CDIAC-74, DOE 94,Dickson and Goyet) 
    243          zis     = 19.924 * zsal / ( 1000. - 1.005 * zsal ) 
    244          zis2    = zis * zis 
    245          zisqrt  = SQRT( zis ) 
     183         zsal15  = SQRT( zsal ) * zsal 
    246184 
    247185         ! Density of Sea Water - F(temp,sal) [kg/m3] 
     
    256194         densSW(ji) = densSW(ji) * 1E-3   ! to get dens in [kg/l] 
    257195 
    258          ! FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970)  
    259          ! (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE IN BROECKER ET AL. (1982)  
    260          ! IS INCORRECT; HERE RGAS IS TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN 
    261          ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS MULTIPLIED BY LN(10.)  
    262          ! TO ALLOW USE OF EXP-FUNCTION WITH BASIS E IN THE FORMULA FOR AKSPP  
    263          ! (CF. EDMOND AND GIESKES (1970), P. 1285 AND P. 1286 (THE SMALL FORMULA ON P. 1286  
    264          ! IS RIGHT AND CONSISTENT WITH THE SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285) 
    265          !----------------------------------------------------------------------------------------- 
    266          zcpexp  = zpres / ( rgas*ztkel ) 
    267          zcpexp2 = zpres * zcpexp 
    268  
    269          ! For Phodphates (phosphoric acid) (DOE 1994) 
    270          !---------------------------------------------- 
    271          zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt & 
    272             &      + ( cp15*ztr + cp16 ) * zsal 
    273          zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt & 
    274             &      + ( cp25*ztr + cp26 ) * zsal 
    275          zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) *  zsqrt & 
    276             &      + ( cp34*ztr + cp35 ) * zsal 
    277  
    278          ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP) 
    279          !-------------------------------------------------------- 
    280          zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt & 
    281             &      + ( cs15*ztr + cs16 ) * zis & 
    282             &      + ( cs17*ztr + cs18 ) * zis2 & 
    283             &      + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal ) 
    284  
    285  
    286          !K1, K2 of carbonic acid, KB of boric acid, KW (H2O) 
    287          !--------------------------------------------------- 
    288          zak1p  = EXP ( zck1p  ) 
    289          zak2p  = EXP ( zck2p  ) 
    290          zak3p  = EXP ( zck3p  ) 
    291          zaksil = EXP ( zcksi  ) 
    292  
    293          zbuf1       = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 ) 
    294          zbuf2       = 0.5 * ( devk4(3) + devk5(3)*ztc ) 
    295          aksis(ji)     = zaksil * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    296  
    297          zbuf1       = - ( devk1(6) + devk2(6)*ztc + devk3(6)*ztc2 ) 
    298          zbuf2       = 0.5 * ( devk4(6) + devk5(6)*ztc ) 
    299          ak1ps(ji)   = zak1p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    300   
    301          zbuf1       = - ( devk1(7) + devk2(7)*ztc + devk3(7)*ztc2 ) 
    302          zbuf2       = 0.5 * ( devk4(7) + devk5(7)*ztc ) 
    303          ak2ps(ji)   = zak2p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    304  
    305          zbuf1       = - ( devk1(8) + devk2(8)*ztc + devk3(8)*ztc2 ) 
    306          zbuf2       = 0.5 * ( devk4(8) + devk5(8)*ztc ) 
    307          ak3ps(ji)   = zak3p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    308  
    309196         ak12s  (ji) = ak1s (ji) * ak2s (ji) 
    310197         ak12ps (ji) = ak1ps(ji) * ak2ps(ji) 
     
    313200         calcon2(ji) = 0.01028 * ( salt(ji) / 35. ) * densSW(ji) 
    314201      ENDDO 
    315  
    316202        
    317 #endif 
     203      IF( ln_timing )  CALL timing_stop('sed_chem') 
    318204 
    319205   END SUBROUTINE sed_chem 
    320206 
    321 #if defined key_sed_off 
    322  
    323    SUBROUTINE sed_chem_off 
    324       !!---------------------------------------------------------------------- 
    325       !!                   ***  ROUTINE sed_chem_off  *** 
    326       !!                     
    327       !! ** Purpose :   compute chemical constants 
     207   SUBROUTINE ahini_for_at_sed(p_hini) 
     208      !!--------------------------------------------------------------------- 
     209      !!                     ***  ROUTINE ahini_for_at  *** 
    328210      !! 
    329       !!   History : 
    330       !!        !  04-10  (N. Emprin, M. Gehlen )  Original code 
    331       !!        !  06-04  (C. Ethe)  Re-organization  
    332       !!----------------------------------------------------------------------   
    333       !! * Local declarations 
    334       INTEGER :: ji 
    335  
    336       REAL(wp) ::  ztkel, ztc, ztc2, zpres, ztr  
    337       REAL(wp) ::  zsal, zsal2, zsqrt, zsal15    
    338       REAL(wp) ::  zis, zis2, zisqrt             
    339       REAL(wp) ::  zdens0, zaw, zbw, zcw         
    340       REAL(wp) ::  zchl, zst, zft, zbuf1, zbuf2  
    341       REAL(wp) ::  zcpexp, zcpexp2               
    342       REAL(wp) ::  zckb, zck1, zck2, zckw        
    343       REAL(wp) ::  zck1p, zck2p, zck3p, zcksi    
    344       REAL(wp) ::  zak1, zak2, zakb, zakw               
    345       REAL(wp) ::  zaksp0, zksp, zks, zkf  
    346  
     211      !! Subroutine returns the root for the 2nd order approximation of the 
     212      !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic  
     213      !! polynomial) around the local minimum, if it exists. 
     214      !! Returns * 1E-03_wp if p_alkcb <= 0 
     215      !!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot 
     216      !!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot 
     217      !!                    and the 2nd order approximation does not have  
     218      !!                    a solution 
     219      !!--------------------------------------------------------------------- 
     220      REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT)  ::  p_hini 
     221      INTEGER  ::   ji, jk 
     222      REAL(wp)  ::  zca1, zba1 
     223      REAL(wp)  ::  zd, zsqrtd, zhmin 
     224      REAL(wp)  ::  za2, za1, za0 
     225      REAL(wp)  ::  p_dictot, p_bortot, p_alkcb 
     226 
     227      IF( ln_timing )  CALL timing_start('ahini_for_at_sed') 
     228      ! 
     229      DO jk = 1, jpksed 
     230         DO ji = 1, jpoce 
     231            p_alkcb  = pwcp(ji,jk,jwalk) / densSW(ji) 
     232            p_dictot = pwcp(ji,jk,jwdic) / densSW(ji)  
     233            p_bortot = borats(ji) / densSW(ji) 
     234            IF (p_alkcb <= 0.) THEN 
     235                p_hini(ji,jk) = 1.e-3 
     236            ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     237                p_hini(ji,jk) = 1.e-10_wp 
     238            ELSE 
     239                zca1 = p_dictot/( p_alkcb + rtrn ) 
     240                zba1 = p_bortot/ (p_alkcb + rtrn ) 
     241           ! Coefficients of the cubic polynomial 
     242                za2 = aKbs(ji)*(1. - zba1) + ak1s(ji)*(1.-zca1) 
     243                za1 = ak1s(ji)*akbs(ji)*(1. - zba1 - zca1)    & 
     244                &     + ak1s(ji)*ak2s(ji)*(1. - (zca1+zca1)) 
     245                za0 = ak1s(ji)*ak2s(ji)*akbs(ji)*(1. - zba1 - (zca1+zca1)) 
     246                                        ! Taylor expansion around the minimum 
     247                zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     248                                        ! for the minimum close to the root 
     249 
     250                IF(zd > 0.) THEN        ! If the discriminant is positive 
     251                  zsqrtd = SQRT(zd) 
     252                  IF(za2 < 0) THEN 
     253                    zhmin = (-za2 + zsqrtd)/3. 
     254                  ELSE 
     255                    zhmin = -za1/(za2 + zsqrtd) 
     256                  ENDIF 
     257                  p_hini(ji,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     258                ELSE 
     259                  p_hini(ji,jk) = 1.e-7 
     260                ENDIF 
     261             ! 
     262            ENDIF 
     263         END DO 
     264      END DO 
     265      ! 
     266      IF( ln_timing )  CALL timing_stop('ahini_for_at_sed') 
     267      ! 
     268   END SUBROUTINE ahini_for_at_sed 
     269 
     270   !=============================================================================== 
     271   SUBROUTINE anw_infsup_sed( p_alknw_inf, p_alknw_sup ) 
     272 
     273   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
     274   ! contributions to total alkalinity (the infimum and the supremum), i.e 
     275   ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) 
     276 
     277   ! Argument variables 
     278   INTEGER :: jk 
     279   REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT) :: p_alknw_inf 
     280   REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT) :: p_alknw_sup 
     281 
     282   DO jk = 1, jpksed 
     283      p_alknw_inf(:,jk) =  -pwcp(:,jk,jwpo4) / densSW(:) 
     284      p_alknw_sup(:,jk) =   (2. * pwcp(:,jk,jwdic) + 2. * pwcp(:,jk,jwpo4) + pwcp(:,jk,jwsil)     & 
     285   &                        + borats(:) ) / densSW(:) 
     286   END DO 
     287 
     288   END SUBROUTINE anw_infsup_sed 
     289 
     290 
     291   SUBROUTINE solve_at_general_sed( p_hini, zhi ) 
     292 
     293   ! Universal pH solver that converges from any given initial value, 
     294   ! determines upper an lower bounds for the solution if required 
     295 
     296   ! Argument variables 
     297   !-------------------- 
     298   REAL(wp), DIMENSION(jpoce,jpksed), INTENT(IN)   :: p_hini 
     299   REAL(wp), DIMENSION(jpoce,jpksed), INTENT(OUT)  :: zhi 
     300 
     301   ! Local variables 
     302   !----------------- 
     303   INTEGER   ::  ji, jk, jn 
     304   REAL(wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor 
     305   REAL(wp)  ::  zdelta, zh_delta 
     306   REAL(wp)  ::  zeqn, zdeqndh, zalka 
     307   REAL(wp)  ::  aphscale 
     308   REAL(wp)  ::  znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic 
     309   REAL(wp)  ::  znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor 
     310   REAL(wp)  ::  znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4 
     311   REAL(wp)  ::  znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil 
     312   REAL(wp)  ::  znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4 
     313   REAL(wp)  ::  znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu 
     314   REAL(wp)  ::  zalk_wat, zdalk_wat 
     315   REAL(wp)  ::  zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit 
     316   LOGICAL   ::  l_exitnow 
     317   REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 
     318   REAL(wp), DIMENSION(jpoce,jpksed) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 
     319 
     320   IF( ln_timing )  CALL timing_start('solve_at_general_sed') 
     321      !  Allocate temporary workspace 
     322   CALL anw_infsup_sed( zalknw_inf, zalknw_sup ) 
     323 
     324   rmask(:,:) = 1.0 
     325   zhi(:,:)   = 0. 
     326 
     327   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
     328   DO jk = 1, jpksed 
     329      DO ji = 1, jpoce 
     330         IF (rmask(ji,jk) == 1.) THEN 
     331            p_alktot = pwcp(ji,jk,jwalk) / densSW(ji) 
     332            aphscale = 1. + sulfats(ji)/aks3s(ji) 
     333            zh_ini = p_hini(ji,jk) 
     334 
     335            zdelta = (p_alktot-zalknw_inf(ji,jk))**2 + 4.*akws(ji) / aphscale 
     336 
     337            IF(p_alktot >= zalknw_inf(ji,jk)) THEN 
     338               zh_min(ji,jk) = 2.*akws(ji) /( p_alktot-zalknw_inf(ji,jk) + SQRT(zdelta) ) 
     339            ELSE 
     340               zh_min(ji,jk) = aphscale * (-(p_alktot-zalknw_inf(ji,jk)) + SQRT(zdelta) ) / 2. 
     341            ENDIF 
     342 
     343            zdelta = (p_alktot-zalknw_sup(ji,jk))**2 + 4.*akws(ji) / aphscale 
     344 
     345            IF(p_alktot <= zalknw_sup(ji,jk)) THEN 
     346               zh_max(ji,jk) = aphscale * (-(p_alktot-zalknw_sup(ji,jk)) + SQRT(zdelta) ) / 2. 
     347            ELSE 
     348               zh_max(ji,jk) = 2.*akws(ji) /( p_alktot-zalknw_sup(ji,jk) + SQRT(zdelta) ) 
     349            ENDIF 
     350 
     351            zhi(ji,jk) = MAX(MIN(zh_max(ji,jk), zh_ini), zh_min(ji,jk)) 
     352         ENDIF 
     353      END DO 
     354   END DO 
     355 
     356   zeqn_absmin(:,:) = HUGE(1._wp) 
     357 
     358   DO jn = 1, jp_maxniter_atgen 
     359   DO jk = 1, jpksed 
     360      DO ji = 1, jpoce 
     361         IF (rmask(ji,jk) == 1.) THEN 
     362 
     363            p_alktot = pwcp(ji,jk,jwalk) / densSW(ji) 
     364            zdic  = pwcp(ji,jk,jwdic) / densSW(ji) 
     365            zbot  = borats(ji) / densSW(ji) 
     366            zpt =  pwcp(ji,jk,jwpo4) / densSW(ji) 
     367            zsit = pwcp(ji,jk,jwsil) / densSW(ji) 
     368            zst = sulfats(ji) 
     369            zft = fluorids(ji) 
     370            aphscale = 1. + sulfats(ji)/aks3s(ji) 
     371            zh = zhi(ji,jk) 
     372            zh_prev = zh 
     373 
     374            ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     375            znumer_dic = 2.*ak1s(ji)*ak2s(ji) + zh*ak1s(ji) 
     376            zdenom_dic = ak1s(ji)*ak2s(ji) + zh*(ak1s(ji) + zh) 
     377            zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     378            zdnumer_dic = ak1s(ji)*ak1s(ji)*ak2s(ji) + zh     & 
     379                          *(4.*ak1s(ji)*ak2s(ji) + zh*ak1s(ji)) 
     380            zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     381 
     382 
     383            ! B(OH)3 - B(OH)4 : n=1, m=0 
     384            znumer_bor = akbs(ji) 
     385            zdenom_bor = akbs(ji) + zh 
     386            zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     387            zdnumer_bor = akbs(ji) 
     388            zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     389 
     390 
     391            ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     392            znumer_po4 = 3.*ak1ps(ji)*ak2ps(ji)*ak3ps(ji)  & 
     393            &            + zh*(2.*ak1ps(ji)*ak2ps(ji) + zh* ak1ps(ji)) 
     394            zdenom_po4 = ak1ps(ji)*ak2ps(ji)*ak3ps(ji)     & 
     395            &            + zh*( ak1ps(ji)*ak2ps(ji) + zh*(ak1ps(ji) + zh)) 
     396            zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     397            zdnumer_po4 = ak1ps(ji)*ak2ps(ji)*ak1ps(ji)*ak2ps(ji)*ak3ps(ji)  & 
     398            &             + zh*(4.*ak1ps(ji)*ak1ps(ji)*ak2ps(ji)*ak3ps(ji)         & 
     399            &             + zh*(9.*ak1ps(ji)*ak2ps(ji)*ak3ps(ji)                         & 
     400            &             + ak1ps(ji)*ak1ps(ji)*ak2ps(ji)                                & 
     401            &             + zh*(4.*ak1ps(ji)*ak2ps(ji) + zh * ak1ps(ji) ) ) ) 
     402            zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     403 
     404            ! H4SiO4 - H3SiO4 : n=1, m=0 
     405            znumer_sil = aksis(ji) 
     406            zdenom_sil = aksis(ji) + zh 
     407            zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     408            zdnumer_sil = aksis(ji) 
     409            zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     410 
     411            ! HSO4 - SO4 : n=1, m=1 
     412            aphscale = 1.0 + zst/aks3s(ji) 
     413            znumer_so4 = aks3s(ji) * aphscale 
     414            zdenom_so4 = aks3s(ji) * aphscale + zh 
     415            zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     416            zdnumer_so4 = aks3s(ji) * aphscale 
     417            zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     418 
     419            ! HF - F : n=1, m=1 
     420            znumer_flu =  akf3s(ji) 
     421            zdenom_flu =  akf3s(ji) + zh 
     422            zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     423            zdnumer_flu = akf3s(ji) 
     424            zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     425 
     426            ! H2O - OH 
     427            zalk_wat   = akws(ji)/zh - zh/aphscale 
     428            zdalk_wat  = -akws(ji)/zh**2 - 1./aphscale 
     429 
     430            ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     431            zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     432            &      + zalk_so4 + zalk_flu                       & 
     433            &      + zalk_wat - p_alktot 
     434 
     435            zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     436            &       + zalk_so4 + zalk_flu + zalk_wat) 
     437 
     438            zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     439            &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     440 
     441            ! Adapt bracketing interval 
     442            IF(zeqn > 0._wp) THEN 
     443               zh_min(ji,jk) = zh_prev 
     444            ELSEIF(zeqn < 0._wp) THEN 
     445               zh_max(ji,jk) = zh_prev 
     446            ENDIF 
     447 
     448            IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jk)) THEN 
     449            ! if the function evaluation at the current point is 
     450            ! not decreasing faster than with a bisection step (at least linearly) 
     451            ! in absolute value take one bisection step on [ph_min, ph_max] 
     452            ! ph_new = (ph_min + ph_max)/2d0 
     453            ! 
     454            ! In terms of [H]_new: 
     455            ! [H]_new = 10**(-ph_new) 
     456            !         = 10**(-(ph_min + ph_max)/2d0) 
     457            !         = SQRT(10**(-(ph_min + phmax))) 
     458            !         = SQRT(zh_max * zh_min) 
     459               zh = SQRT(zh_max(ji,jk) * zh_min(ji,jk)) 
     460               zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     461            ELSE 
     462            ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     463            !           = -zdeqndh * LOG(10) * [H] 
     464            ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     465            ! 
     466            ! pH_new = pH_old + \deltapH 
     467            ! 
     468            ! [H]_new = 10**(-pH_new) 
     469            !         = 10**(-pH_old - \Delta pH) 
     470            !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     471            !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     472            !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     473 
     474               zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     475 
     476               IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     477                  zh          = zh_prev*EXP(zh_lnfactor) 
     478               ELSE 
     479                  zh_delta    = zh_lnfactor*zh_prev 
     480                  zh          = zh_prev + zh_delta 
     481               ENDIF 
     482 
     483               IF( zh < zh_min(ji,jk) ) THEN 
     484               ! if [H]_new < [H]_min 
     485               ! i.e., if ph_new > ph_max then 
     486               ! take one bisection step on [ph_prev, ph_max] 
     487               ! ph_new = (ph_prev + ph_max)/2d0 
     488               ! In terms of [H]_new: 
     489               ! [H]_new = 10**(-ph_new) 
     490               !         = 10**(-(ph_prev + ph_max)/2d0) 
     491               !         = SQRT(10**(-(ph_prev + phmax))) 
     492               !         = SQRT([H]_old*10**(-ph_max)) 
     493               !         = SQRT([H]_old * zh_min) 
     494                  zh                = SQRT(zh_prev * zh_min(ji,jk)) 
     495                  zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     496               ENDIF 
     497 
     498               IF( zh > zh_max(ji,jk) ) THEN 
     499               ! if [H]_new > [H]_max 
     500               ! i.e., if ph_new < ph_min, then 
     501               ! take one bisection step on [ph_min, ph_prev] 
     502               ! ph_new = (ph_prev + ph_min)/2d0 
     503               ! In terms of [H]_new: 
     504               ! [H]_new = 10**(-ph_new) 
     505               !         = 10**(-(ph_prev + ph_min)/2d0) 
     506               !         = SQRT(10**(-(ph_prev + ph_min))) 
     507               !         = SQRT([H]_old*10**(-ph_min)) 
     508               !         = SQRT([H]_old * zhmax) 
     509                  zh                = SQRT(zh_prev * zh_max(ji,jk)) 
     510                  zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     511               ENDIF 
     512            ENDIF 
     513 
     514            zeqn_absmin(ji,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jk)) 
     515 
     516            ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     517            ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     518            ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     519            ! Alternatively: 
     520            ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     521            !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     522            !             < 1/LOG(10) * rdel 
     523 
     524            ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     525 
     526            ! rdel <-- pp_rdel_ah_target 
     527            l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     528 
     529            IF(l_exitnow) THEN 
     530               rmask(ji,jk) = 0. 
     531            ENDIF 
     532 
     533            zhi(ji,jk) =  zh 
     534 
     535            IF(jn >= jp_maxniter_atgen) THEN 
     536               zhi(ji,jk) = -1._wp 
     537            ENDIF 
     538 
     539         ENDIF 
     540      END DO 
     541   END DO 
     542   END DO 
     543   ! 
     544   IF( ln_timing )  CALL timing_stop('solve_at_general_sed') 
     545 
     546   END SUBROUTINE solve_at_general_sed 
     547 
     548   SUBROUTINE sed_chem_cst 
     549      !!--------------------------------------------------------------------- 
     550      !!                     ***  ROUTINE sed_chem_cst  *** 
     551      !! 
     552      !! ** Purpose :   Sea water chemistry computed following MOCSY protocol 
     553      !!                Computation is done at the bottom of the ocean only 
     554      !! 
     555      !! ** Method  : - ... 
     556      !!--------------------------------------------------------------------- 
     557      INTEGER  ::   ji 
     558      REAL(wp), DIMENSION(jpoce) :: saltprac, temps 
     559      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
     560      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 
     561      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2 
     562      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1, zc1, zplat 
     563      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1, za2 
     564      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw 
     565      REAL(wp) ::   zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi 
     566      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1 
     567      REAL(wp) ::   total2free, free2SWS, total2SWS, SWS2total 
     568      !!--------------------------------------------------------------------- 
     569      ! 
     570      IF( ln_timing )   CALL timing_start('sed_chem_cst') 
     571      ! 
     572      ! Computation of chemical constants require practical salinity 
     573      ! Thus, when TEOS08 is used, absolute salinity is converted to 
     574      ! practical salinity 
     575      ! ------------------------------------------------------------- 
     576      IF (neos == -1) THEN 
     577         saltprac(:) = salt(:) * 35.0 / 35.16504 
     578      ELSE 
     579         saltprac(:) = temp(:) 
     580      ENDIF 
     581 
     582      ! 
     583      ! Computations of chemical constants require in situ temperature 
     584      ! Here a quite simple formulation is used to convert 
     585      ! potential temperature to in situ temperature. The errors is less than 
     586      ! 0.04°C relative to an exact computation 
     587      ! --------------------------------------------------------------------- 
     588         DO ji = 1, jpoce 
     589            zpres = zkbot(ji) / 1000. 
     590            za1 = 0.04 * ( 1.0 + 0.185 * temp(ji) + 0.035 * (saltprac(ji) - 35.0) ) 
     591            za2 = 0.0075 * ( 1.0 - temp(ji) / 30.0 ) 
     592            temps(ji) = temp(ji) - za1 * zpres + za2 * zpres**2 
     593         END DO 
    347594 
    348595      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    349       !------------------------------------- 
    350       ! [chem constants]=mol/kg solution (or (mol/kg sol)2 for akws and aksp) 
    351  
     596      ! ------------------------------- 
    352597      DO ji = 1, jpoce 
    353          ztkel   = temp(ji) + 273.16 
    354          ztc     = temp(ji) 
    355          ztc2    = ztc * ztc 
    356          zpres   = press(ji) 
    357          ! zqtt    = ztkel * 0.01 
    358          zsal    = salt(ji) 
    359          zsal2   = zsal * zsal  
    360          zsqrt   = SQRT( zsal ) 
     598         ! SET PRESSION ACCORDING TO SAUNDER (1980) 
     599         zc1 = 5.92E-3  
     600         zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*zkbot(ji)))) / 4.42E-6 
     601         zpres = zpres / 10.0 
     602 
     603         ! SET ABSOLUTE TEMPERATURE 
     604         ztkel   = temps(ji) + 273.15 
     605         zsal    = saltprac(ji) 
     606         zsqrt  = SQRT( zsal ) 
    361607         zsal15  = zsqrt * zsal 
    362          zlogt   = LOG( ztkel ) 
    363          ztr     = 1./ ztkel 
    364          ! zis=ionic strength (ORNL/CDIAC-74, DOE 94,Dickson and Goyet) 
    365          zis     = 19.924 * zsal / ( 1000. - 1.005 * zsal ) 
    366          zis2    = zis * zis 
    367          zisqrt  = SQRT( zis ) 
    368  
    369  
    370          ! Density of Sea Water - F(temp,sal) [kg/m3] 
    371          zdens0 =  Ddsw(1) + Ddsw(2) * ztc + Ddsw(3) * ztc2 & 
    372                   + Ddsw(4) * ztc * ztc2 + Ddsw(5) * ztc2 * ztc2 & 
    373                   + Ddsw(6) * ztc * ztc2 * ztc2 
    374          zaw =  Adsw(1) + Adsw(2) * ztc + Adsw(3)* ztc2 + Adsw(4) * ztc * ztc2 & 
    375               + Adsw(5) * ztc2 * ztc2 
    376          zbw =  Bdsw(1) + Bdsw(2) * ztc + Bdsw(3) * ztc2 
    377          zcw =  Cdsw 
    378          densSW(ji) = zdens0 + zaw * zsal + zbw * zsal15 + zcw * zsal * zsal 
    379          densSW(ji) = densSW(ji) * 1E-3   ! to get dens in [kg/l] 
    380  
    381  
    382          ! FORMULA FOR CPEXP AFTER EDMOND AND GIESKES (1970)  
    383          ! (REFERENCE TO CULBERSON AND PYTKOQICZ (1968) AS MADE IN BROECKER ET AL. (1982)  
    384          ! IS INCORRECT; HERE RGAS IS TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN 
    385          ! DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS MULTIPLIED BY LN(10.)  
    386          ! TO ALLOW USE OF EXP-FUNCTION WITH BASIS E IN THE FORMULA FOR AKSPP  
    387          ! (CF. EDMOND AND GIESKES (1970), P. 1285 AND P. 1286 (THE SMALL FORMULA ON P. 1286  
    388          ! IS RIGHT AND CONSISTENT WITH THE SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285) 
    389          !----------------------------------------------------------------------------------------- 
    390          zcpexp  = zpres / ( rgas*ztkel ) 
     608         zlogt  = LOG( ztkel ) 
     609         ztr    = 1. / ztkel 
     610         zis    = 19.924 * zsal / ( 1000.- 1.005 * zsal ) 
     611         zis2   = zis * zis 
     612         zisqrt = SQRT( zis ) 
     613         ztc    = temps(ji) 
     614 
     615         ! CHLORINITY (WOOSTER ET AL., 1969) 
     616         zcl     = zsal / 1.80655 
     617 
     618         ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 
     619         zst     = 0.14 * zcl /96.062 
     620 
     621         ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 
     622         zft     = 0.000067 * zcl /18.9984 
     623 
     624         ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 
     625         zcks    = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt         & 
     626         &         + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt & 
     627         &         + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis    & 
     628         &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         & 
     629         &         + LOG(1.0 - 0.001005 * zsal)) 
     630 
     631         ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 
     632         zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   & 
     633         &         + LOG(1.0d0 - 0.001005d0*zsal)            & 
     634         &         + LOG(1.0d0 + zst/zcks)) 
     635 
     636         ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 
     637         zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        & 
     638         &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         & 
     639         &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   & 
     640         &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      & 
     641         &      * zlogt + 0.053105*zsqrt*ztkel 
     642 
     643         ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 
     644         ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 
     645         zck1    = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt  & 
     646                   - 0.011555*zsal + 0.0001152*zsal*zsal) 
     647         zck2    = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt      & 
     648                   - 0.01781*zsal + 0.0001122*zsal*zsal) 
     649 
     650         ! PKW (H2O) (MILLERO, 1995) from composite data 
     651         zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    & 
     652                   - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 
     653 
     654         ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 
     655         zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   & 
     656         &          + (-106.736*ztr + 0.69171) * zsqrt       & 
     657         &          + (-0.65643*ztr - 0.01844) * zsal 
     658 
     659         zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  & 
     660         &          + (-160.340*ztr + 1.3566)*zsqrt          & 
     661         &          + (0.37335*ztr - 0.05778)*zsal 
     662 
     663         zck3p    = -3070.75*ztr - 18.126                    & 
     664         &          + (17.27039*ztr + 2.81197) * zsqrt       & 
     665         &          + (-44.99486*ztr - 0.09984) * zsal 
     666 
     667         ! CONSTANT FOR SILICATE, MILLERO (1995) 
     668         zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   & 
     669         &          + (-458.79*ztr + 3.5913) * zisqrt       & 
     670         &          + (188.74*ztr - 1.5998) * zis           & 
     671         &          + (-12.1652*ztr + 0.07871) * zis2       & 
     672         &          + LOG(1.0 - 0.001005*zsal) 
     673 
     674         ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 
     675         !       (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 
     676         zaksp0  = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel )   & 
     677         &         + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt  & 
     678         &         - 0.07711*zsal + 0.0041249*zsal15 
     679 
     680         ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 
     681         zak1    = 10**(zck1) * total2SWS 
     682         zak2    = 10**(zck2) * total2SWS 
     683         zakb    = EXP( zckb ) * total2SWS 
     684         zakw    = EXP( zckw ) 
     685         zaksp1  = 10**(zaksp0) 
     686         zak1p   = exp( zck1p ) 
     687         zak2p   = exp( zck2p ) 
     688         zak3p   = exp( zck3p ) 
     689         zaksi   = exp( zcksi ) 
     690         zckf    = zckf * total2SWS 
     691 
     692         ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 
     693         !        (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE 
     694         !        IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS 
     695         !        TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN 
     696         !        DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS 
     697         !        MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION 
     698         !        WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND 
     699         !        & GIESKES (1970), P. 1285-1286 (THE SMALL 
     700         !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 
     701         !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 
     702         zcpexp  = zpres / (rgas*ztkel) 
    391703         zcpexp2 = zpres * zcpexp 
    392704 
    393  
    394          ! chlorinity (WOOSTER ET AL., 1969) 
    395          !--------------------------------------- 
    396          zchl = zsal * salchl 
    397  
    398          ! total sulfate concentration [mol/kg soln] 
    399          ! -------------------------------------- 
    400          zst = st1 * zchl * st2 
    401  
    402          ! total fluoride concentration [mol/kg soln] 
    403          ! -------------------------------------- 
    404          zft = ft1 * zchl * ft2 
    405  
    406          ! dissociation constant for carbonate (Mehrback 74 - Dickson & Millero 87) 
    407          !--------------------------------------------------------------------------- 
    408          zck1 = c10*ztr - c11 + c12*zlogt - c13*zsal + c14*zsal2 
    409          zck2 = c20*ztr + c21 - c22*zlogt - c23*zsal + c24*zsal2 
    410  
    411          ! dissociation constant for sulfates (Dickson 1990) 
    412          !-------------------------------------------------- 
    413          zks = EXP(  ks0 + ks1*ztr + ks2*zlogt & 
    414             &    + ( ks3*ztr + ks4 + ks5*zlogt ) * zisqrt & 
    415             &    + ( ks6*ztr + ks7 + ks8*zlogt ) * zis    & 
    416             &    +   ks9*ztr*zis*zisqrt + ks10*ztr*zis2   & 
    417             &    +   LOG( ks11 + ks12*zsal ) ) 
    418  
    419          ! dissociation constant for fluorides (Dickson and Riley 79) 
    420          !-------------------------------------------------- 
    421          zkf = EXP( kf0 + kf1*ztr + kf2*zisqrt + LOG( kf3 + kf4*zsal ) ) 
    422  
    423          ! dissociation constant for borates (Doe 94) 
    424          !-------------------------------------------------- 
    425          zckb = (  cb0 + cb1*zsqrt + cb2*zsal + cb3*zsal15 + cb4*zsal2) * ztr & 
    426             &  + ( cb5 + cb6*zsqrt + cb7*zsal) & 
    427             &  + ( cb8 + cb9*zsqrt + cb10*zsal) * zlogt & 
    428             &  +   cb11*zsqrt*ztkel + LOG( ( 1. + zst/zks + zft/zkf ) / ( 1. + zst/zks ) )  
    429  
    430          ! PKW (H2O) (DICKSON AND RILEY, 1979) 
    431          !-------------------------------------- 
    432          zckw =   cw0*ztr + cw1 + cw2*zlogt & 
    433             & +( cw3*ztr + cw4 + cw5*zlogt )* zsqrt + cw6*zsal 
    434           
    435          ! For Phodphates (phosphoric acid) (DOE 1994) 
    436          !---------------------------------------------- 
    437          zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt & 
    438             &      + ( cp15*ztr + cp16 ) * zsal 
    439          zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt & 
    440             &      + ( cp25*ztr + cp26 ) * zsal 
    441          zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) *  zsqrt & 
    442             &      + ( cp34*ztr + cp35 ) * zsal 
    443  
    444          ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP) 
    445          !-------------------------------------------------------- 
    446          zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt & 
    447             &      + ( cs15*ztr + cs16 ) * zis & 
    448             &      + ( cs17*ztr + cs18 ) * zis2 & 
    449             &      + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal ) 
    450  
    451          ! apparent solublity product K'SP of calcite in seawater 
    452          ! (S=27-43, T=2-25 DEG C) AT pres =0 (INGLE, 1975, EQ. 6) 
    453          ! prob: olivier a log = ln et C. Heize a LOG10(sal) 
    454          ! aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log(sal)+akcc4*tkel*tkel) 
    455          ! aksp0 = 1.E-7*(akcc1+akcc2*sal**(1./3.)+akcc3*log10(sal)+akcc4*tkel*tkel) 
    456          !-------------------------------------------------------------------- 
    457          zaksp0 = akcc1 + akcc2*ztkel + akcc3*ztr + akcc4 * LOG10(ztkel) & 
    458             &  + ( akcc5 + akcc6*ztkel+ akcc7*ztr ) * zsqrt & 
    459             &  +  akcc8*zsal + akcc9*zsal15 
    460  
    461          !K1, K2 of carbonic acid, KB of boric acid, KW (H2O) 
    462          !--------------------------------------------------- 
    463          zak1   = 10**( -zck1  ) 
    464          zak2   = 10**( -zck2  ) 
    465          zakb   = EXP ( zckb   )  
    466          zakw   = EXP ( zckw   ) 
    467          zksp   = 10**( zaksp0 ) 
    468  
    469  
    470  
    471          ! KB of boric acid, K1,K2 of carbonic acid pressure correction  
    472          ! after Culberson and  AND Pytkowicz (1968) (CF. BROECKER ET AL., 1982) Millero 95 
    473          !-------------------------------------------------------------------------------- 
    474          zbuf1       = - ( devk1(1) + devk2(1)*ztc + devk3(1)*ztc2 ) 
    475          zbuf2       = 0.5 * ( devk4(1) + devk5(1)*ztc ) 
    476          ak1s(ji)    = zak1 * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    477  
    478          zbuf1       = -( devk1(2) + devk2(2)*ztc + devk3(2)*ztc2 ) 
    479          zbuf2       = 0.5 * ( devk4(2) + devk5(2)*ztc ) 
    480          ak2s(ji)    = zak2 * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    481  
    482          zbuf1       = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 ) 
    483          zbuf2       = 0.5 * ( devk4(3) + devk5(3) * ztc ) 
    484          akbs(ji)    = zakb * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    485  
    486          zbuf1       = - ( devk1(4) + devk2(4)*ztc + devk3(4)*ztc2 ) 
    487          zbuf2       = 0.5 * ( devk4(4) + devk5(4)*ztc ) 
    488          akws(ji)    = zakw * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    489  
    490  
    491          ! APPARENT SOLUBILITY PRODUCT K''SP OF CALCITE (OR ARAGONITE) 
    492          ! AS FUNCTION OF PRESSURE FOLLWING EDMOND AND GIESKES (1970) 
    493          ! (P. 1285) AND BERNER (1976) 
    494          !----------------------------------------------------------------- 
    495          ! aksp(ji) = aksp0*exp(zcpexp*(devks-devkst*tc)) 
    496          ! or following Mucci 
    497          zbuf1      = - ( devk1(5) + devk2(5)*ztc + devk3(5)*ztc2 ) 
    498          zbuf2      = 0.5 *( devk4(5) + devk5(5)*ztc ) 
    499          aksps(ji)   = zksp * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    500  
    501          ! For Phodphates (phosphoric acid) (DOE 1994) 
    502          !---------------------------------------------- 
    503          zck1p = cp10 + cp11*ztr + cp12*zlogt + ( cp13*ztr + cp14 ) * zsqrt & 
    504             &      + ( cp15*ztr + cp16 ) * zsal 
    505          zck2p = cp20 + cp21*ztr + cp22*zlogt + ( cp23*ztr + cp24 ) * zsqrt & 
    506             &      + ( cp25*ztr + cp26 ) * zsal 
    507          zck3p = cp30 + cp31*ztr + ( cp32*ztr + cp33 ) *  zsqrt & 
    508             &      + ( cp34*ztr + cp35 ) * zsal 
    509  
    510          ! For silicates (DOE 1994) change to mol/kg soln) (OCMIP) 
    511          !-------------------------------------------------------- 
    512          zcksi = cs10 + cs11*ztr + cs12*zlogt + ( cs13*ztr + cs14) * zisqrt & 
    513             &      + ( cs15*ztr + cs16 ) * zis & 
    514             &      + ( cs17*ztr + cs18 ) * zis2 & 
    515             &      + LOG( 1. + cs19*zsal ) + LOG( cs20 + cs21*zsal ) 
    516  
    517  
    518          !K1, K2 of carbonic acid, KB of boric acid, KW (H2O) 
    519          !--------------------------------------------------- 
    520          zak1p  = EXP ( zck1p  ) 
    521          zak2p  = EXP ( zck2p  ) 
    522          zak3p  = EXP ( zck3p  ) 
    523          zaksil = EXP ( zcksi  ) 
    524  
    525          zbuf1       = - ( devk1(3) + devk2(3)*ztc + devk3(3)*ztc2 ) 
    526          zbuf2       = 0.5 * ( devk4(3) + devk5(3)*ztc ) 
    527          aksis(ji)     = zaksil * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    528  
    529          zbuf1       = - ( devk1(6) + devk2(6)*ztc + devk3(6)*ztc2 ) 
    530          zbuf2       = 0.5 * ( devk4(6) + devk5(6)*ztc ) 
    531          ak1ps(ji)   = zak1p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    532   
    533          zbuf1       = - ( devk1(7) + devk2(7)*ztc + devk3(7)*ztc2 ) 
    534          zbuf2       = 0.5 * ( devk4(7) + devk5(7)*ztc ) 
    535          ak2ps(ji)   = zak2p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    536  
    537          zbuf1       = - ( devk1(8) + devk2(8)*ztc + devk3(8)*ztc2 ) 
    538          zbuf2       = 0.5 * ( devk4(8) + devk5(8)*ztc ) 
    539          ak3ps(ji)   = zak3p * EXP( zbuf1*zcpexp + zbuf2*zcpexp2 ) 
    540  
    541          ! total borat concentration. [mol/l] 
    542          ! or from Millero 1995 [mol/l] : borat(l) = 0.000416_8*(sal/35._8)*densSW(l) 
    543          ! -------------------------------------------------------------------------- 
    544          borats(ji) = bor1 * zchl * bor2 * densSW(ji) 
    545  
    546          ak12s  (ji) = ak1s (ji) * ak2s (ji) 
    547          ak12ps (ji) = ak1ps(ji) * ak2ps(ji) 
    548          ak123ps(ji) = ak1ps(ji) * ak2ps(ji) * ak3ps(ji) 
    549  
    550          calcon2(ji) = 0.01028 * ( zsal / 35. ) * densSW(ji) 
    551  
    552       ENDDO 
    553  
    554    END SUBROUTINE sed_chem_off 
    555  
    556 #endif 
    557  
    558 #else 
    559    !!====================================================================== 
    560    !! MODULE sedchem  :   Dummy module  
    561    !!====================================================================== 
    562    !! $Id$ 
    563 CONTAINS 
    564    SUBROUTINE sed_chem( kt )         ! Empty routine 
    565       INTEGER, INTENT(in) :: kt 
    566       WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt 
    567    END SUBROUTINE sed_chem 
    568  
    569    !!====================================================================== 
    570  
    571 #endif 
     705         ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 
     706         !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 
     707         !        (CF. BROECKER ET AL., 1982) 
     708 
     709         zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 
     710         zbuf2  = 0.5 * ( devk40 + devk50 * ztc ) 
     711         ak1s(ji) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     712 
     713         zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
     714         zbuf2  = 0.5 * ( devk41 + devk51 * ztc ) 
     715         ak2s(ji) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     716 
     717         zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 
     718         zbuf2  = 0.5 * ( devk42 + devk52 * ztc ) 
     719         akbs(ji) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     720 
     721         zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 
     722         zbuf2  = 0.5 * ( devk43 + devk53 * ztc ) 
     723         akws(ji) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     724 
     725         zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 
     726         zbuf2  = 0.5 * ( devk44 + devk54 * ztc ) 
     727         aks3s(ji) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     728 
     729         zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
     730         zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
     731         akf3s(ji) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     732 
     733         zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 
     734         zbuf2  = 0.5 * ( devk47 + devk57 * ztc ) 
     735         ak1ps(ji) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     736 
     737         zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 
     738         zbuf2  = 0.5 * ( devk48 + devk58 * ztc ) 
     739         ak2ps(ji) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     740 
     741         zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 
     742         zbuf2  = 0.5 * ( devk410 + devk510 * ztc ) 
     743         aksis(ji) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     744 
     745         ! CONVERT FROM DIFFERENT PH SCALES 
     746         total2free  = 1.0/(1.0 + zst/aks3s(ji)) 
     747         free2SWS    = 1. + zst/aks3s(ji) + zft/akf3s(ji) 
     748         total2SWS   = total2free * free2SWS 
     749         SWS2total   = 1.0 / total2SWS 
     750 
     751         ! Convert to total scale 
     752         ak1s(ji)  = ak1s(ji)  * SWS2total 
     753         ak2s(ji)  = ak2s(ji)  * SWS2total 
     754         akbs(ji)  = akbs(ji)  * SWS2total 
     755         akws(ji)  = akws(ji)  * SWS2total 
     756         ak1ps(ji) = ak1ps(ji) * SWS2total 
     757         ak2ps(ji) = ak2ps(ji) * SWS2total 
     758         ak3ps(ji) = ak3ps(ji) * SWS2total 
     759         aksis(ji) = aksis(ji) * SWS2total 
     760         akf3s(ji) = akf3s(ji) / total2free 
     761 
     762         ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 
     763         !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO 
     764         !        (P. 1285) AND BERNER (1976) 
     765         zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 
     766         zbuf2  = 0.5 * ( devk46 + devk56 * ztc ) 
     767         aksps(ji) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     768 
     769         ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 
     770         borats(ji)   = 0.0002414 * zcl / 10.811 
     771         sulfats(ji)  = zst 
     772         fluorids(ji) = zft 
     773 
     774         ! Iron and SIO3 saturation concentration from ... 
     775         sieqs(ji) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6 
     776      END DO 
     777      ! 
     778      IF( ln_timing )  CALL timing_stop('sed_chem_cst') 
     779      ! 
     780   END SUBROUTINE sed_chem_cst 
     781 
    572782 
    573783END MODULE sedchem 
  • NEMO/trunk/src/TOP/PISCES/SED/sedco3.F90

    r9598 r10222  
    11MODULE sedco3 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!              ***  MODULE  sedco3  *** 
     
    76   !! * Modules used 
    87   USE sed     ! sediment global variable 
     8   USE sedchem 
     9   USE lib_mpp         ! distribued memory computing library 
    910 
    1011 
     
    1516   PUBLIC sed_co3      
    1617 
    17  
    18    !! * Module variables 
    19    REAL(wp) :: epsmax   =  1.e-12      ! convergence limite value 
    20  
    2118   !!---------------------------------------------------------------------- 
    22    !!   OPA 9.0   !   NEMO Consortium   (2003) 
     19   !!   OPA 9.0   !   LODYC-IPSL   (2003) 
    2320   !!---------------------------------------------------------------------- 
    2421 
     
    4542      !! * Arguments 
    4643      INTEGER, INTENT(in)  :: kt   ! time step 
    47  
    4844      ! 
    4945      !---Local variables 
    50       INTEGER  :: jiter, ji, jk, ipt  ! dummy loop indices 
     46      INTEGER  :: ji, jk           ! dummy loop indices 
    5147 
    52       INTEGER  :: itermax             ! maximum number of Newton-Raphson iterations 
    53       INTEGER  :: itime               ! number of time to perform Newton-Raphson algorithm 
    54       LOGICAL  :: lconv = .FALSE.     ! flag for convergence 
    55       REAL(wp) :: brems               !  relaxation. parameter 
    56       REAL(wp) :: zresm, zresm1, zhipor_min  
    57       REAL(wp) :: zalk, zbor, zsil, zpo4, zdic 
    58       REAL(wp) :: zh_old, zh_old2, zh_old3, zh_old4 
    59       REAL(wp) :: zuu, zvv, zduu, zdvv  
    60       REAL(wp) :: zup, zvp, zdup, zdvp 
    61       REAL(wp) :: zah_old, zah_olds 
    62       REAL(wp) :: zh_new, zh_new2, zco3 
    63  
     48      REAL(wp), DIMENSION(jpoce,jpksed) :: zhinit, zhi 
    6449     !!---------------------------------------------------------------------- 
    6550 
     51      IF( ln_timing )  CALL timing_start('sed_co3') 
     52 
    6653      IF( kt == nitsed000 ) THEN 
    67          WRITE(numsed,*) ' sed_co3 : carbonate ion and proton concentration calculation  ' 
    68          WRITE(numsed,*) ' ' 
     54         IF (lwp) WRITE(numsed,*) ' sed_co3 : carbonate ion and proton concentration calculation  ' 
     55         IF (lwp) WRITE(numsed,*) ' ' 
    6956      ENDIF 
    7057 
    71       itermax     = 30 
    72       brems       = 1. 
    73       itime       = 0 
     58      DO jk = 1, jpksed 
     59         zhinit(:,jk)   = hipor(:,jk) / densSW(:) 
     60      END DO 
    7461 
     62      !     ------------------------------------------- 
     63      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
     64      !     ------------------------------------------- 
     65 
     66      CALL solve_at_general_sed(zhinit, zhi) 
    7567 
    7668      DO jk = 1, jpksed 
    77          DO WHILE( itime <= 2 ) 
    78             lconv  = .FALSE. 
    79             IF( itime > 0 ) THEN   
    80                ! increase max number of iterations and relaxation parameter 
    81                itermax = 200 
    82 !!               brems   = 0.3 
    83                IF( itime == 2 ) hipor(1:jpoce,jk) = 3.e-9 ! re-initilazation of [H] values 
    84             ENDIF 
     69         DO ji = 1, jpoce 
     70            co3por(ji,jk) = pwcp(ji,jk,jwdic) * ak1s(ji) * ak2s(ji) / (zhi(ji,jk)**2   & 
     71            &               + ak1s(ji) * zhi(ji,jk) + ak1s(ji) * ak2s(ji) + rtrn ) 
     72            hipor(ji,jk)  = zhi(ji,jk) * densSW(ji) 
     73         END DO 
     74      END DO 
    8575 
    86 iflag:      DO jiter = 1, itermax 
    87  
    88                 ! Store previous hi field.    
    89                zresm = -1.e10 
    90                ipt = 1 
    91                DO ji = 1, jpoce 
    92                   ! dissociation constant are in mol/kg of solution 
    93                   ! convert pwcp concentration [mol/l] in mol/kg for solution 
    94                   zalk    = pwcp(ji,jk,jwalk) / densSW(ji) 
    95                   zh_old  = hipor(ji,jk) / densSW(ji) 
    96                   zh_old2 = zh_old  * zh_old 
    97                   zh_old3 = zh_old2 * zh_old 
    98                   zh_old4 = zh_old3 * zh_old 
    99                   zbor    = borats(ji) / densSW(ji) 
    100                   zsil    = pwcp(ji,jk,jwsil) / densSW(ji) 
    101                   zpo4    = pwcp(ji,jk,jwpo4) / densSW(ji) 
    102                   zdic    = pwcp(ji,jk,jwdic) / densSW(ji)                
    103                   ! intermediate calculation  
    104                   zuu     = zdic * ( ak1s(ji) / zh_old + 2.* ak12s(ji) / zh_old2 ) 
    105                   zvv     = 1. + ak1s(ji) / zh_old + ak12s(ji) / zh_old2 
    106                   zduu    = zdic * ( -ak1s(ji) / zh_old2 - 4. * ak12s(ji) / zh_old3 ) 
    107                   zdvv    = -ak1s(ji) / zh_old2 - 2. * ak12s(ji) / zh_old3 
    108                   zup     = zpo4 * ( ak12ps(ji) / zh_old2 + 2. * ak123ps(ji) / zh_old3 - 1.) 
    109                   zvp     = 1. + ak1ps(ji) / zh_old + ak12ps(ji) / zh_old2 + ak123ps(ji) / zh_old3 
    110                   zdup    = zpo4 * ( -2. * ak12ps(ji) / zh_old3 - 6. * ak123ps(ji) / zh_old4 ) 
    111                   zdvp    = -ak1ps(ji) / zh_old2 - 2.* ak12ps(ji) / zh_old3 - 3. * ak123ps(ji) / zh_old4 
    112                    
    113                   zah_old  = zuu / zvv + zbor / ( 1. + zh_old / akbs(ji) ) + & 
    114                      &      akws(ji) / zh_old - zh_old + zsil / ( 1. + zh_old / aksis(ji) ) + & 
    115                      &      zup / zvp 
    116                    
    117                   zah_olds = ( ( zduu * zvv - zdvv * zuu ) / ( zvv * zvv ) )      - & 
    118                      &        zbor / akbs(ji) * ( 1. + zh_old / akbs(ji) )**(-2) - & 
    119                      &        akws(ji) / zh_old2 - 1. -                            & 
    120                      &        zsil / aksis(ji) * ( 1. + zh_old / aksis(ji) )**(-2) + & 
    121                      &       ( ( zdup * zvp - zdvp * zup ) / ( zvp * zvp ) ) 
    122                   ! 
    123                   zh_new = zh_old - brems * ( zah_old - zalk ) / zah_olds 
    124                   !  
    125                   zresm1 = ABS( zh_new - zh_old ) 
    126                   IF( zresm1 > zresm ) THEN  
    127                      zresm = zresm1   
    128                   ENDIF 
    129                   ! 
    130                   zh_new2  = zh_new * zh_new 
    131                   zco3   = ( ak12s(ji) * zdic ) / ( ak12s(ji) + ak1s(ji) * zh_new + zh_new2) 
    132                   ! again in mol/l 
    133                   hipor (ji,jk) = zh_new * densSW(ji) 
    134                   co3por(ji,jk) = zco3   * densSW(ji) 
    135                    
    136                ENDDO  ! end loop ji 
    137                 
    138                ! convergence test 
    139                IF( zresm <= epsmax ) THEN 
    140                   lconv = .TRUE. 
    141                   !minimum value of hipor 
    142                   zhipor_min = MINVAL( hipor(1:jpoce,jk ) ) 
    143                   EXIT iflag 
    144                ENDIF 
    145  
    146             ENDDO iflag 
    147  
    148             IF( lconv ) THEN 
    149 !               WRITE(numsed,*) ' convergence after iter =', jiter, ' iterations ;  res =',zresm   
    150                IF( zhipor_min < 0. ) THEN  
    151                   IF ( itime == 0 ) THEN 
    152 !                     WRITE(numsed,*) '    but hipor < 0 ; try one more time for jk = ', jk  
    153 !                     WRITE(numsed,*) '    with re-initialization of initial PH field '        
    154                      itime = 2 
    155                   ELSE 
    156 !                     WRITE(numsed,*) ' convergence after iter =', jiter, ' iterations ;  res =',zresm  
    157 !                     WRITE(numsed,*) '    but hipor < 0, again for second time for jk = ', jk  
    158 !                     WRITE(numsed,*) ' We stop : STOP ' 
    159                      STOP 
    160                   ENDIF 
    161                ELSE 
    162 !                  WRITE(numsed,*) ' successfull convergence for level jk = ',jk,& 
    163 !                     &               '  after iter =', jiter, ' iterations ;  res =',zresm   
    164 !                  WRITE(numsed,*) ' ' 
    165                   itime = 3 
    166                ENDIF 
    167             ELSE 
    168                itime = itime + 1 
    169                WRITE(numsed,*) ' No convergence for jk = ', jk, ' after ', itime, '  try'             
    170                IF ( itime == 1 ) THEN 
    171                   WRITE(numsed,*) ' try one more time with more iterations and higher relax. value' 
    172                ELSE IF ( itime == 2 ) THEN 
    173                   WRITE(numsed,*) ' try one more time for with more iterations, higher relax. value'                
    174                   WRITE(numsed,*) ' and with re-initialization of initial PH field '  
    175                ELSE        
    176                   WRITE(numsed,*) ' No more... we stop ' 
    177                   STOP 
    178                ENDIF 
    179             ENDIF 
    180          ENDDO ! End of WHILE LOOP 
    181      ENDDO 
     76     IF( ln_timing )  CALL timing_stop('sed_co3') 
    18277 
    18378   END SUBROUTINE sed_co3 
    184 #else 
    185    !!====================================================================== 
    186    !! MODULE sedco3  :   Dummy module  
    187    !!====================================================================== 
    188    !! $Id$ 
    189 CONTAINS 
    190    SUBROUTINE sed_co3( kt )         ! Empty routine 
    191       INTEGER, INTENT(in) :: kt 
    192       WRITE(*,*) 'sed_co3: You should not have seen this print! error?', kt 
    193    END SUBROUTINE sed_co3 
    194  
    195    !!====================================================================== 
    196  
    197 #endif 
    19879 
    19980END MODULE sedco3 
  • NEMO/trunk/src/TOP/PISCES/SED/seddsr.F90

    r5215 r10222  
    11MODULE seddsr 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!              ***  MODULE  seddsr  *** 
    5    !!    Sediment : dissolution and reaction in pore water 
     4   !!    Sediment : dissolution and reaction in pore water related  
     5   !!    related to organic matter 
    66   !!===================================================================== 
    77   !! * Modules used 
    88   USE sed     ! sediment global variable 
    9    USE sedmat  ! linear system of equations 
    10    USE sedco3  ! carbonate ion and proton concentration  
     9   USE sed_oce 
     10   USE sedini 
     11   USE lib_mpp         ! distribued memory computing library 
     12   USE lib_fortran 
     13 
     14   IMPLICIT NONE 
     15   PRIVATE 
    1116 
    1217   PUBLIC sed_dsr 
     
    1419   !! * Module variables 
    1520 
    16    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: cons_o2 
    17    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: cons_no3 
    18    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: sour_no3 
    19    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: sour_c13 
    20    REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC ::  dens_mol_wgt  ! molecular density  
     21   REAL(wp) :: zadsnh4 
     22   REAL(wp), DIMENSION(jpsol), PUBLIC      :: dens_mol_wgt  ! molecular density  
     23   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zvolc    ! temp. variables 
     24 
    2125 
    2226   !! $Id$ 
    2327CONTAINS 
    2428    
    25    SUBROUTINE sed_dsr( kt )  
     29   SUBROUTINE sed_dsr( kt, knt )  
    2630      !!---------------------------------------------------------------------- 
    2731      !!                   ***  ROUTINE sed_dsr  *** 
     
    2933      !!  ** Purpose :  computes pore water dissolution and reaction 
    3034      !! 
    31       !!  ** Methode :  implicit simultaneous computation of undersaturation 
    32       !!               resulting from diffusive pore water transport and chemical 
    33       !!               pore water reactions. Solid material is consumed according 
    34       !!               to redissolution and remineralisation 
    35       !! 
    36       !!  ** Remarks : 
    37       !!              - undersaturation : deviation from saturation concentration 
    38       !!              - reaction rate   : sink of undersaturation from dissolution 
    39       !!                                 of solid material  
     35      !!  ** Methode :  Computation of the redox reactions in sediment. 
     36      !!                The main redox reactions are solved in sed_dsr whereas 
     37      !!                the secondary reactions are solved in sed_dsr_redoxb. 
     38      !!                A strand spliting approach is being used here (see  
     39      !!                sed_dsr_redoxb for more information).  
    4040      !! 
    4141      !!   History : 
     
    4343      !!        !  04-10 (N. Emprin, M. Gehlen ) f90 
    4444      !!        !  06-04 (C. Ethe)  Re-organization 
     45      !!        !  19-08 (O. Aumont) Debugging and improvement of the model. 
     46      !!                             The original method is replaced by a  
     47      !!                              Strand splitting method which deals  
     48      !!                              well with stiff reactions. 
    4549      !!---------------------------------------------------------------------- 
    4650      !! Arguments 
    47       INTEGER, INTENT(in) ::   kt       ! number of iteration 
     51      INTEGER, INTENT(in) ::   kt, knt       ! number of iteration 
    4852      ! --- local variables 
    49       INTEGER :: ji, jk, js, jw   ! dummy looop indices 
    50       INTEGER :: nv               ! number of variables in linear tridiagonal eq 
    51  
    52       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zrearat    ! reaction rate in pore water 
    53       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zundsat    ! undersaturation ; indice jpwatp1 is for calcite    
    54       REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zmo2_0, zmo2_1  ! temp. array for mass balance calculation 
    55       REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zmno3_0, zmno3_1, zmno3_2 
    56       REAL(wp), DIMENSION(:    ), ALLOCATABLE :: zmc13_0, zmc13_1, zmc13_2, zmc13_3 
    57       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zvolc    ! temp. variables 
     53      INTEGER :: ji, jk, js, jw, jn   ! dummy looop indices 
     54 
     55      REAL(wp), DIMENSION(jpoce,jpksed) :: zrearat1, zrearat2, zrearat3    ! reaction rate in pore water 
     56      REAL(wp), DIMENSION(jpoce,jpksed) :: zundsat    ! undersaturation ; indice jpwatp1 is for calcite    
     57      REAL(wp), DIMENSION(jpoce,jpksed) :: zkpoc, zkpos, zkpor, zlimo2, zlimno3, zlimso4, zlimfeo    ! undersaturation ; indice jpwatp1 is for calcite    
     58      REAL(wp), DIMENSION(jpoce)        :: zsumtot 
    5859      REAL(wp)  ::  zsolid1, zsolid2, zsolid3, zvolw, zreasat 
    59  
     60      REAL(wp)  ::  zsatur, zsatur2, znusil, zkpoca, zkpocb, zkpocc 
     61      REAL(wp)  ::  zratio, zgamma, zbeta, zlimtmp, zundsat2 
    6062      !! 
    6163      !!---------------------------------------------------------------------- 
    6264 
    63       IF( kt == nitsed000 ) THEN 
    64          WRITE(numsed,*) ' sed_dsr : Dissolution reaction ' 
    65          WRITE(numsed,*) ' ' 
    66          !  
    67          ALLOCATE( dens_mol_wgt((jpoce) )  
    68          dens_mol_wgt(1:jpsol) = dens / mol_wgt(1:jpsol) 
    69          !  
    70          ALLOCATE( cons_o2 (jpoce) ) ;   ALLOCATE( cons_no3(jpoce) )  
    71          ALLOCATE( sour_no3(jpoce) ) ;   ALLOCATE( sour_c13(jpoce) )   
     65      IF( ln_timing )  CALL timing_start('sed_dsr') 
     66! 
     67      IF( kt == nitsed000 .AND. knt == 1 ) THEN 
     68         IF (lwp) THEN 
     69            WRITE(numsed,*) ' sed_dsr : Dissolution reaction ' 
     70            WRITE(numsed,*) ' ' 
     71         ENDIF 
    7272      ENDIF 
    7373 
    74       ! Initialization of data for mass balance calculation 
    75       !--------------------------------------------------- 
    76  
    77       tokbot(:,:)  = 0. 
    78       cons_o2 (:)  = 0.  
    79       cons_no3(:)  = 0.   
    80       sour_no3(:)  = 0.   
    81       sour_c13(:)  = 0.        
    82     
    83       ! Initializations 
    84       !---------------------- 
    85       ALLOCATE( zmo2_0 (jpoce) ) ;  ALLOCATE( zmo2_1 (jpoce) )  
    86       ALLOCATE( zmno3_0(jpoce) ) ;  ALLOCATE( zmno3_1(jpoce) )  ;  ALLOCATE( zmno3_2(jpoce) )  
    87       ALLOCATE( zmc13_0(jpoce) ) ;  ALLOCATE( zmc13_1(jpoce) )  ;  ALLOCATE( zmc13_2(jpoce) ) ;  ALLOCATE( zmc13_3(jpoce) )  
    88  
    89       zmo2_0 (:) = 0.  ; zmo2_1 (:) = 0. 
    90       zmno3_0(:) = 0.  ; zmno3_1(:) = 0.  ;  zmno3_2(:) = 0. 
    91       zmc13_0(:) = 0.  ; zmc13_1(:) = 0.  ;  zmc13_2(:) = 0.  ; zmc13_3(:) = 0. 
     74     ! Initializations 
     75     !---------------------- 
    9276       
    93       ALLOCATE( zrearat(jpoce,jpksed,3) ) ;  ALLOCATE( zundsat(jpoce,jpksed,3) )       
    94       zrearat(:,:,:)   = 0.    ;   zundsat(:,:,:) = 0.  
    95  
    96  
    97       ALLOCATE( zvolc(jpoce,jpksed,jpsol) )  
    98       zvolc(:,:,:)   = 0. 
    99  
    100       !-------------------------------------------------------------------- 
    101       ! Temporary accomodation to take account of  particule rain deposition 
    102       !--------------------------------------------------------------------- 
    103        
    104        
    105       ! 1. Change of geometry 
    106       !    Increase of dz3d(2) thickness : dz3d(2) = dz3d(2)+dzdep 
    107       !    Warning : no change for dz(2) 
    108       !--------------------------------------------------------- 
    109       dz3d(1:jpoce,2) = dz3d(1:jpoce,2) + dzdep(1:jpoce) 
    110  
    111        
    112       ! New values for volw3d(:,2) and vols3d(:,2) 
    113       ! Warning : no change neither for volw(2) nor  vols(2) 
    114       !------------------------------------------------------ 
    115       volw3d(1:jpoce,2) = dz3d(1:jpoce,2) * por(2) 
    116       vols3d(1:jpoce,2) = dz3d(1:jpoce,2) * por1(2) 
     77      zrearat1(:,:)   = 0.    ;   zundsat(:,:) = 0. ; zkpoc(:,:) = 0. 
     78      zlimo2 (:,:)    = 0.    ;   zlimno3(:,:) = 0. ; zrearat2(:,:) = 0. 
     79      zlimso4(:,:)    = 0.    ;   zkpor(:,:)   = 0. ; zrearat3(:,:) = 0. 
     80      zkpos  (:,:)    = 0. 
     81      zsumtot(:)      = rtrn 
     82   
     83      ALLOCATE( zvolc(jpoce, jpksed, jpsol) ) 
     84      zvolc(:,:,:)    = 0. 
     85      zadsnh4 = 1.0 / ( 1.0 + adsnh4 ) 
     86 
     87      ! Inhibition terms for the different redox equations 
     88      ! -------------------------------------------------- 
     89      DO jk = 1, jpksed 
     90         DO ji = 1, jpoce 
     91            zkpoc(ji,jk) = reac_pocl  
     92            zkpos(ji,jk) = reac_pocs 
     93            zkpor(ji,jk) = reac_pocr 
     94         END DO 
     95      END DO 
    11796 
    11897      ! Conversion of volume units 
     
    12099      DO js = 1, jpsol 
    121100         DO jk = 1, jpksed 
    122             DO ji = 1, jpoce     
     101            DO ji = 1, jpoce 
    123102               zvolc(ji,jk,js) = ( vols3d(ji,jk) * dens_mol_wgt(js) ) /  & 
    124                   &              ( volw3d(ji,jk) * 1.e-3 )      
     103                  &              ( volw3d(ji,jk) * 1.e-3 ) 
    125104            ENDDO 
    126105         ENDDO 
    127106      ENDDO 
    128107 
    129       ! 2. Change of previous solid fractions (due to volum changes) for k=2 
    130       !--------------------------------------------------------------------- 
    131  
    132       DO js = 1, jpsol 
    133          DO ji = 1, jpoce 
    134             solcp(ji,2,js) = solcp(ji,2,js) * dz(2) / dz3d(ji,2) 
    135          ENDDO 
    136       END DO 
    137  
    138       ! 3. New solid fractions (including solid rain fractions) for k=2   
    139       !------------------------------------------------------------------    
    140       DO js = 1, jpsol 
    141          DO ji = 1, jpoce 
    142             solcp(ji,2,js) = solcp(ji,2,js) + & 
    143             &           ( rainrg(ji,js) / raintg(ji) ) * ( dzdep(ji) / dz3d(ji,2) ) 
    144             ! rainrm are temporary cancel 
    145             rainrm(ji,js) = 0. 
    146          END DO 
    147       ENDDO 
    148  
    149       ! 4.  Adjustment of bottom water concen.(pwcp(1)):  
    150       !     We impose that pwcp(2) is constant. Including dzdep in dz3d(:,2) we assume  
    151       !     that dzdep has got a porosity of por(2). So pore water volum of jk=2 increase. 
    152       !     To keep pwcp(2) cste we must compensate this "increase" by a slight adjusment 
    153       !     of bottom water concentration. 
    154       !     This adjustment is compensate at the end of routine 
    155       !------------------------------------------------------------- 
    156       DO jw = 1, jpwat 
    157          DO ji = 1, jpoce 
    158             pwcp(ji,1,jw) = pwcp(ji,1,jw) - & 
    159                &            pwcp(ji,2,jw) * dzdep(ji) * por(2) / dzkbot(ji) 
    160          END DO 
    161       ENDDO 
    162  
    163   
    164108      !---------------------------------------------------------- 
    165       ! 5.  Beginning of  Pore Water diffusion and solid reaction 
     109      ! 5.  Beginning of solid reaction 
    166110      !--------------------------------------------------------- 
    167        
    168       !----------------------------------------------------------------------------- 
    169       ! For jk=2,jpksed, and for couple  
    170       !  1 : jwsil/jsopal  ( SI/Opal ) 
    171       !  2 : jsclay/jsclay ( clay/clay )  
    172       !  3 : jwoxy/jspoc   ( O2/POC ) 
    173       !  reaction rate is a function of solid=concentration in solid reactif in [mol/l]  
    174       !  and undersaturation in [mol/l]. 
    175       !  Solid weight fractions should be in ie [mol/l]) 
    176       !  second member and solution are in zundsat variable 
    177       !------------------------------------------------------------------------- 
    178  
    179       !number of variables 
    180       nv  = 3 
    181       
    182       DO jk = 1, jpksed 
    183          DO ji = 1, jpoce 
    184             ! For Silicic Acid and clay 
    185             zundsat(ji,jk,1) = sat_sil   - pwcp(ji,jk,jwsil) 
    186             zundsat(ji,jk,2) = sat_clay 
    187             ! For O2 
    188             zundsat(ji,jk,3) = pwcp(ji,jk,jwoxy) / so2ut  
    189          ENDDO 
    190       ENDDO 
    191        
    192111       
    193112      ! Definition of reaction rates [rearat]=sans dim  
    194113      ! For jk=1 no reaction (pure water without solid) for each solid compo 
    195       DO ji = 1, jpoce 
    196          zrearat(ji,1,:) = 0. 
    197       ENDDO 
    198  
     114      zrearat1(:,:) = 0. 
     115      zrearat2(:,:) = 0. 
     116      zrearat3(:,:) = 0. 
     117 
     118      zundsat(:,:) = pwcp(:,:,jwoxy) 
     119 
     120      DO jk = 2, jpksed 
     121         DO ji = 1, jpoce 
     122            zlimo2(ji,jk) = 1.0 / ( zundsat(ji,jk) + xksedo2 ) 
     123            zsolid1 = zvolc(ji,jk,jspoc)  * solcp(ji,jk,jspoc) 
     124            zsolid2 = zvolc(ji,jk,jspos)  * solcp(ji,jk,jspos) 
     125            zsolid3 = zvolc(ji,jk,jspor)  * solcp(ji,jk,jspor) 
     126            zkpoca  = zkpoc(ji,jk) * zlimo2(ji,jk) 
     127            zkpocb  = zkpos(ji,jk) * zlimo2(ji,jk) 
     128            zkpocc  = zkpor(ji,jk) * zlimo2(ji,jk) 
     129            zrearat1(ji,jk)  = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     130            &                 ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 
     131            zrearat2(ji,jk)  = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     132            &                 ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 
     133            zrearat3(ji,jk)  = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     134            &                 ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 
     135         ENDDO 
     136      ENDDO 
    199137 
    200138      ! left hand side of coefficient matrix 
    201       DO jk = 2, jpksed 
    202          DO ji = 1, jpoce 
    203             zsolid1 = zvolc(ji,jk,jsopal) * solcp(ji,jk,jsopal) 
    204             zsolid2 = zvolc(ji,jk,jsclay) * solcp(ji,jk,jsclay) 
    205             zsolid3 = zvolc(ji,jk,jspoc)  * solcp(ji,jk,jspoc) 
    206  
    207             zrearat(ji,jk,1)  = ( reac_sil * dtsed * zsolid1 ) / & 
    208                &                ( 1. + reac_sil * dtsed * zundsat(ji,jk,1 ) ) 
    209             zrearat(ji,jk,2)  = ( reac_clay * dtsed * zsolid2 ) / & 
    210                &                ( 1. + reac_clay * dtsed * zundsat(ji,jk,2 ) ) 
    211             zrearat(ji,jk,3)  = ( reac_poc  * dtsed * zsolid3 ) / & 
    212                &                ( 1. + reac_poc  * dtsed * zundsat(ji,jk,3 ) ) 
    213          ENDDO 
    214       ENDDO 
    215  
    216  
    217       CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 
    218  
     139!      DO jn = 1, 5 
     140      DO jk = 2, jpksed 
     141         DO ji = 1, jpoce 
     142jflag1:     DO jn = 1, 10 
     143               zsolid1 = zvolc(ji,jk,jspoc)  * solcp(ji,jk,jspoc) 
     144               zsolid2 = zvolc(ji,jk,jspos)  * solcp(ji,jk,jspos) 
     145               zsolid3 = zvolc(ji,jk,jspor)  * solcp(ji,jk,jspor) 
     146               zbeta   = xksedo2 - pwcp(ji,jk,jwoxy) + so2ut * ( zrearat1(ji,jk)    & 
     147               &         + zrearat2(ji,jk) + zrearat3(ji,jk) ) 
     148               zgamma = - xksedo2 * pwcp(ji,jk,jwoxy) 
     149               zundsat2 = zundsat(ji,jk) 
     150               zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 
     151               zlimo2(ji,jk) = 1.0 / ( zundsat(ji,jk) + xksedo2 ) 
     152               zkpoca  = zkpoc(ji,jk) * zlimo2(ji,jk) 
     153               zkpocb  = zkpos(ji,jk) * zlimo2(ji,jk) 
     154               zkpocc  = zkpor(ji,jk) * zlimo2(ji,jk) 
     155               zrearat1(ji,jk)  = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     156               &                 ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 
     157               zrearat2(ji,jk)  = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     158               &                 ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 
     159               zrearat3(ji,jk)  = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     160               &                 ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 
     161               IF ( ABS( (zundsat(ji,jk)-zundsat2)/(zundsat2+rtrn)) < 1E-8 ) THEN 
     162                  EXIT jflag1 
     163               ENDIF 
     164            END DO jflag1 
     165         END DO 
     166      END DO 
    219167 
    220168      ! New solid concentration values (jk=2 to jksed) for each couple  
    221       DO js = 1, nv 
    222          DO jk = 2, jpksed 
    223             DO ji = 1, jpoce 
    224                zreasat = zrearat(ji,jk,js) * zundsat(ji,jk,js) / zvolc(ji,jk,js) 
    225                solcp(ji,jk,js) = solcp(ji,jk,js) - zreasat 
    226             ENDDO 
    227          ENDDO 
    228       ENDDO 
    229       ! mass of O2/NO3 before POC remin. for mass balance check  
    230       ! det. of o2 consomation/NO3 production Mc13 
    231       DO jk = 1, jpksed 
    232          DO ji = 1, jpoce 
    233             zvolw = volw3d(ji,jk) * 1.e-3 
    234             zmo2_0 (ji)  = zmo2_0 (ji) + pwcp(ji,jk,jwoxy) * zvolw 
    235             zmno3_0(ji)  = zmno3_0(ji) + pwcp(ji,jk,jwno3) * zvolw 
    236             zmc13_0(ji)  = zmc13_0(ji) + pwcp(ji,jk,jwc13) * zvolw 
     169      DO jk = 2, jpksed 
     170         DO ji = 1, jpoce 
     171            zreasat = zrearat1(ji,jk) * zlimo2(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 
     172            solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 
     173            zreasat = zrearat2(ji,jk) * zlimo2(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 
     174            solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 
     175            zreasat = zrearat3(ji,jk) * zlimo2(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 
     176            solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 
    237177         ENDDO 
    238178      ENDDO 
    239179 
    240180      ! New pore water concentrations     
    241       DO jk = 1, jpksed 
     181      DO jk = 2, jpksed 
    242182         DO ji = 1, jpoce 
    243183            ! Acid Silicic  
    244             pwcp(ji,jk,jwsil)  = sat_sil - zundsat(ji,jk,1)             
    245             ! For O2 (in mol/l) 
    246             pwcp(ji,jk,jwoxy)  = zundsat(ji,jk,3) * so2ut  
    247             zreasat = zrearat(ji,jk,3) * zundsat(ji,jk,3)    ! oxygen          
     184            pwcp(ji,jk,jwoxy)  = zundsat(ji,jk) 
     185            zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimo2(ji,jk) * zundsat(ji,jk)    ! oxygen          
    248186            ! For DIC 
    249187            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat 
    250             ! For nitrates 
    251             pwcp(ji,jk,jwno3)  = pwcp(ji,jk,jwno3) + zreasat * srno3             
     188            zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 
    252189            ! For Phosphate (in mol/l) 
    253             pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * spo4r             
     190            pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * spo4r 
     191            ! For iron (in mol/l) 
     192            pwcp(ji,jk,jwfe2)  = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 
    254193            ! For alkalinity 
    255             pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) - zreasat * ( srno3 + 2.* spo4r )            
    256             ! For DIC13 
    257             pwcp(ji,jk,jwc13)  = pwcp(ji,jk,jwc13) + zreasat * rc13P * pdb 
    258          ENDDO 
    259       ENDDO 
    260  
    261  
    262       ! Mass of O2 for mass balance check and det. of o2 consomation 
    263       DO jk = 1, jpksed 
    264          DO ji = 1, jpoce 
    265             zvolw = volw3d(ji,jk) * 1.e-3 
    266             zmo2_1 (ji) = zmo2_1 (ji) + pwcp(ji,jk,jwoxy) * zvolw 
    267             zmno3_1(ji) = zmno3_1(ji) + pwcp(ji,jk,jwno3) * zvolw 
    268             zmc13_1(ji) = zmc13_1(ji) + pwcp(ji,jk,jwc13) * zvolw 
    269          ENDDO 
    270       ENDDO 
    271  
    272       DO ji = 1, jpoce 
    273          cons_o2 (ji) = zmo2_0 (ji) - zmo2_1 (ji) 
    274          sour_no3(ji) = zmno3_1(ji) - zmno3_0(ji)      
    275          sour_c13(ji) = zmc13_1(ji) - zmc13_0(ji)  
    276       ENDDO 
    277   
     194            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + zreasat * ( srno3 * zadsnh4 - 2.* spo4r ) 
     195            ! Ammonium 
     196            pwcp(ji,jk,jwnh4)  = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 
     197            ! Ligands 
     198            sedligand(ji,jk)   = sedligand(ji,jk) + ratligc * zreasat - reac_ligc * sedligand(ji,jk) 
     199         ENDDO 
     200      ENDDO 
    278201 
    279202      !-------------------------------------------------------------------- 
     
    282205      !-------------------------------------------------------------------- 
    283206 
    284       nv = 1 
    285       DO jk = 1, jpksed 
    286          DO ji = 1, jpoce 
    287             zundsat(ji,jk,1) = pwcp(ji,jk,jwno3) / srDnit 
    288          ENDDO 
    289       ENDDO 
    290       DO jk = 2, jpksed 
    291          DO ji = 1, jpoce 
    292             IF( pwcp(ji,jk,jwoxy) < sthrO2 ) THEN 
     207      zrearat1(:,:) = 0. 
     208      zrearat2(:,:) = 0. 
     209      zrearat3(:,:) = 0. 
     210 
     211      zundsat(:,:) = pwcp(:,:,jwno3) 
     212 
     213      DO jk = 2, jpksed 
     214         DO ji = 1, jpoce 
     215            zlimno3(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) / ( zundsat(ji,jk) + xksedno3 ) 
     216            zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 
     217            zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 
     218            zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 
     219            zkpoca = zkpoc(ji,jk) * zlimno3(ji,jk) 
     220            zkpocb = zkpos(ji,jk) * zlimno3(ji,jk) 
     221            zkpocc = zkpor(ji,jk) * zlimno3(ji,jk) 
     222            zrearat1(ji,jk)  = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     223            &                 ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 
     224            zrearat2(ji,jk)  = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     225            &                 ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 
     226            zrearat3(ji,jk)  = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     227            &                 ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 
     228        END DO 
     229      END DO 
     230 
     231!      DO jn = 1, 5 
     232      DO jk = 2, jpksed 
     233         DO ji = 1, jpoce 
     234jflag2:    DO jn = 1, 10 
     235               zlimtmp = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) 
    293236               zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 
    294                zrearat(ji,jk,1) = ( reac_no3 * dtsed * zsolid1 ) / & 
    295                   &                    ( 1. + reac_no3 * dtsed * zundsat(ji,jk,1 ) ) 
    296             ELSE 
    297                zrearat(ji,jk,1) = 0. 
    298             ENDIF 
    299          END DO 
    300       END DO 
    301  
    302  
    303       ! solves tridiagonal system 
    304       CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 
     237               zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 
     238               zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 
     239               zbeta   = xksedno3 - pwcp(ji,jk,jwno3) + srDnit * ( zrearat1(ji,jk)    & 
     240               &         + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimtmp 
     241               zgamma = - xksedno3 * pwcp(ji,jk,jwno3) 
     242               zundsat2 = zundsat(ji,jk) 
     243               zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 
     244               zlimno3(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) / ( zundsat(ji,jk) + xksedno3 ) 
     245               zkpoca  = zkpoc(ji,jk) * zlimno3(ji,jk) 
     246               zkpocb  = zkpos(ji,jk) * zlimno3(ji,jk) 
     247               zkpocc  = zkpor(ji,jk) * zlimno3(ji,jk) 
     248               zrearat1(ji,jk)  = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     249               &                 ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 
     250               zrearat2(ji,jk)  = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     251               &                 ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 
     252               zrearat3(ji,jk)  = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     253               &                 ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 
     254               IF ( ABS( (zundsat(ji,jk)-zundsat2)/(zundsat2+rtrn)) < 1E-8 ) THEN 
     255                  EXIT jflag2 
     256               ENDIF 
     257            END DO jflag2 
     258         END DO 
     259      END DO 
    305260 
    306261 
     
    308263      DO jk = 2, jpksed 
    309264         DO ji = 1, jpoce 
    310             zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) / zvolc(ji,jk,jspoc) 
     265            zreasat = zrearat1(ji,jk) * zlimno3(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 
    311266            solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 
     267            zreasat = zrearat2(ji,jk) * zlimno3(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 
     268            solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 
     269            zreasat = zrearat3(ji,jk) * zlimno3(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 
     270            solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 
    312271         ENDDO 
    313272      ENDDO 
    314273 
    315274      ! New dissolved concentrations 
    316       DO jk = 1, jpksed 
    317          DO ji = 1, jpoce 
    318             zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1)     
     275      DO jk = 2, jpksed 
     276         DO ji = 1, jpoce 
    319277            ! For nitrates 
    320             pwcp(ji,jk,jwno3)  =  zundsat(ji,jk,1) * srDnit 
     278            pwcp(ji,jk,jwno3)  =  zundsat(ji,jk) 
     279            zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimno3(ji,jk) * zundsat(ji,jk) 
    321280            ! For DIC 
    322281            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat 
     282            zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 
    323283            ! For Phosphate (in mol/l) 
    324284            pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * spo4r             
     285            ! Ligands 
     286            sedligand(ji,jk)   = sedligand(ji,jk) + ratligc * zreasat 
     287            ! For iron (in mol/l) 
     288            pwcp(ji,jk,jwfe2)  = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 
    325289            ! For alkalinity 
    326             pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + zreasat * ( srDnit - 2.* spo4r )            
    327             ! For DIC13 
    328             pwcp(ji,jk,jwc13)  = pwcp(ji,jk,jwc13) + zreasat * rc13P * pdb 
    329          ENDDO 
    330       ENDDO 
    331  
    332  
    333       ! Mass of O2 for mass balance check and det. of o2 consomation 
    334       DO jk = 1, jpksed 
    335          DO ji = 1, jpoce 
    336             zvolw = volw3d(ji,jk) * 1.e-3 
    337             zmno3_2(ji) = zmno3_2(ji) + pwcp(ji,jk ,jwno3) * zvolw 
    338             zmc13_2(ji) = zmc13_2(ji) + pwcp(ji,jk ,jwc13) * zvolw    
    339          ENDDO 
    340       ENDDO 
    341  
    342       DO ji = 1, jpoce 
    343          cons_no3(ji) = zmno3_1(ji) - zmno3_2(ji)   
    344          sour_c13(ji) = sour_c13(ji) + zmc13_2(ji) - zmc13_1(ji)      
    345       ENDDO 
    346  
    347  
    348       !--------------------------- 
    349       ! Solves PO4 diffusion  
    350       !---------------------------- 
    351  
    352       nv = 1 
    353       DO jk = 1, jpksed 
    354          DO ji = 1, jpoce 
    355             zundsat(ji,jk,1) = pwcp(ji,jk,jwpo4) 
    356             zrearat(ji,jk,1) = 0. 
    357          ENDDO 
    358       ENDDO 
    359  
    360  
    361       ! solves tridiagonal system 
    362       CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 
    363  
    364  
    365       ! New undsaturation values and dissolved concentrations 
    366       DO jk = 1, jpksed 
    367          DO ji = 1, jpoce 
    368             pwcp(ji,jk,jwpo4) = zundsat(ji,jk,1) 
    369          ENDDO 
    370       ENDDO 
    371  
    372  
    373       !--------------------------------------------------------------- 
    374       ! Performs CaCO3 particle deposition and redissolution (indice 9) 
    375       !-------------------------------------------------------------- 
    376  
    377       ! computes co3por from the updated pwcp concentrations (note [co3por] = mol/l) 
    378  
    379       CALL sed_co3( kt ) 
    380  
    381  
    382       nv = 1 
    383       ! *densSW(l)**2 converts aksps [mol2/kg sol2] into [mol2/l2] to get [undsat] in [mol/l] 
    384       DO jk = 1, jpksed 
    385          DO ji = 1, jpoce 
    386             zundsat(ji,jk,1) = aksps(ji) * densSW(ji) * densSW(ji) / calcon2(ji) & 
    387                &                     - co3por(ji,jk) 
    388             ! positive values of undersaturation 
    389             zundsat(ji,jk,1) = MAX( 0., zundsat(ji,jk,1) )             
    390          ENDDO 
    391       ENDDO 
    392  
    393       DO jk = 2, jpksed 
    394          DO ji = 1, jpoce 
    395             zsolid1 = zvolc(ji,jk,jscal) * solcp(ji,jk,jscal) 
    396             zrearat(ji,jk,1) = ( reac_cal * dtsed * zsolid1 ) / & 
    397                   &               ( 1. + reac_cal * dtsed * zundsat(ji,jk,1) ) 
    398          END DO 
    399       END DO 
    400  
    401  
    402       ! solves tridiagonal system 
    403       CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 
    404  
    405  
    406       ! New solid concentration values (jk=2 to jksed) for cacO3 
    407       DO jk = 2, jpksed 
    408          DO ji = 1, jpoce 
    409             zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1) / zvolc(ji,jk,jscal) 
    410             solcp(ji,jk,jscal) = solcp(ji,jk,jscal) - zreasat 
    411          ENDDO 
    412       ENDDO 
     290            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + zreasat * ( srDnit + srno3 * zadsnh4 - 2.* spo4r )            
     291            ! Ammonium 
     292            pwcp(ji,jk,jwnh4)  = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 
     293         ENDDO 
     294      ENDDO 
     295 
     296      !-------------------------------------------------------------------- 
     297      ! Begining POC iron reduction 
     298      ! (indice n�5 for couple POFe(OH)3 ie solcp(:,:,jspoc)/pwcp(:,:,jsfeo)) 
     299      !-------------------------------------------------------------------- 
     300 
     301      zrearat1(:,:) = 0. 
     302      zrearat2(:,:) = 0. 
     303      zrearat3(:,:) = 0. 
     304 
     305      zundsat(:,:) = solcp(:,:,jsfeo) 
     306 
     307      DO jk = 2, jpksed 
     308         DO ji = 1, jpoce 
     309            zlimfeo(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3)    & 
     310            &                / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) / ( zundsat(ji,jk) + xksedfeo ) 
     311            zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 
     312            zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 
     313            zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 
     314            zkpoca = zkpoc(ji,jk) * zlimfeo(ji,jk) 
     315            zkpocb = zkpos(ji,jk) * zlimfeo(ji,jk) 
     316            zkpocc = zkpor(ji,jk) * zlimfeo(ji,jk) 
     317            zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     318            &                    ( 1. + zkpoca * zundsat(ji,jk) * dtsed2 ) 
     319            zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     320            &                    ( 1. + zkpocb * zundsat(ji,jk) * dtsed2 ) 
     321            zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     322            &                    ( 1. + zkpocc * zundsat(ji,jk) * dtsed2 ) 
     323         END DO 
     324      END DO 
     325 
     326!      DO jn = 1, 5 
     327      DO jk = 2, jpksed 
     328         DO ji = 1, jpoce 
     329jflag3:     DO jn = 1, 10 
     330               zlimtmp = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3)    & 
     331               &                / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) 
     332               zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 
     333               zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 
     334               zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 
     335               zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) / zvolc(ji,jk,jsfeo) 
     336               zbeta   = xksedfeo - solcp(ji,jk,jsfeo) + 4.0 * zreasat * zlimtmp 
     337               zgamma  = -xksedfeo * solcp(ji,jk,jsfeo) 
     338               zundsat2 = zundsat(ji,jk) 
     339               zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 
     340               zlimfeo(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3)    & 
     341               &                / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) / ( zundsat(ji,jk) + xksedfeo ) 
     342               zkpoca  = zkpoc(ji,jk) * zlimfeo(ji,jk) 
     343               zkpocb  = zkpos(ji,jk) * zlimfeo(ji,jk) 
     344               zkpocc  = zkpor(ji,jk) * zlimfeo(ji,jk) 
     345               zrearat1(ji,jk) = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     346               &                    ( 1. + zkpoca * zundsat(ji,jk) * dtsed2 ) 
     347               zrearat2(ji,jk) = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     348               &                    ( 1. + zkpocb * zundsat(ji,jk) * dtsed2 ) 
     349               zrearat3(ji,jk) = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     350               &                    ( 1. + zkpocc * zundsat(ji,jk) * dtsed2 ) 
     351               IF ( ABS( (zundsat(ji,jk)-zundsat2)/( MAX(0.,zundsat2)+rtrn)) < 1E-8 ) THEN 
     352                  EXIT jflag3 
     353               ENDIF 
     354            END DO jflag3 
     355         END DO 
     356      END DO 
     357 
     358 
     359         ! New solid concentration values (jk=2 to jksed) for each couple  
     360      DO jk = 2, jpksed 
     361         DO ji = 1, jpoce 
     362            zreasat = zrearat1(ji,jk) * zlimfeo(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 
     363            solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 
     364            zreasat = zrearat2(ji,jk) * zlimfeo(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 
     365            solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 
     366            zreasat = zrearat3(ji,jk) * zlimfeo(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 
     367            solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 
     368         END DO 
     369      END DO 
    413370 
    414371      ! New dissolved concentrations 
    415       DO jk = 1, jpksed 
    416          DO ji = 1, jpoce 
    417             zreasat = zrearat(ji,jk,1) * zundsat(ji,jk,1)     
     372      DO jk = 2, jpksed 
     373         DO ji = 1, jpoce 
     374            zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimfeo(ji,jk) * zundsat(ji,jk) 
     375            ! For FEOH 
     376            solcp(ji,jk,jsfeo) = zundsat(ji,jk) 
    418377            ! For DIC 
    419378            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat 
     379            zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 
     380            ! For Phosphate (in mol/l) 
     381            pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * ( spo4r + 4.0 * redfep ) 
     382            ! Ligands 
     383            sedligand(ji,jk)   = sedligand(ji,jk) + ratligc * zreasat 
     384            ! For iron (in mol/l) 
     385            pwcp(ji,jk,jwfe2)  = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 
    420386            ! For alkalinity 
    421             pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + 2.* zreasat  
    422             ! For DIC13 
    423             pwcp(ji,jk,jwc13)  = pwcp(ji,jk,jwc13) + zreasat * rc13Ca * pdb 
    424          ENDDO 
    425       ENDDO 
    426  
    427       DO jk = 1, jpksed 
    428          DO ji = 1, jpoce 
    429             zmc13_3(ji) = zmc13_3(ji) + pwcp(ji,jk,jwc13) * volw3d(ji,jk) * 1.e-3                   
    430          ENDDO 
    431       ENDDO 
    432  
    433       DO ji = 1, jpoce      
    434          sour_c13(ji) = sour_c13(ji) + zmc13_3(ji) - zmc13_2(ji)    
    435       ENDDO 
    436        
    437       !------------------------------------------------- 
    438       ! Beginning DIC, Alkalinity and DIC13 diffusion 
    439       !------------------------------------------------- 
    440        
    441       nv = 3 
    442       DO jk = 1, jpksed 
    443          DO ji = 1, jpoce       
    444             zundsat(ji,jk,1) = pwcp(ji,jk,jwdic) 
    445             zundsat(ji,jk,2) = pwcp(ji,jk,jwalk) 
    446             zundsat(ji,jk,3) = pwcp(ji,jk,jwc13) 
    447        
    448             zrearat(ji,jk,1) = 0. 
    449             zrearat(ji,jk,2) = 0. 
    450             zrearat(ji,jk,3) = 0. 
    451        
    452          ENDDO 
    453       ENDDO 
    454  
    455  
    456       ! solves tridiagonal system 
    457       CALL sed_mat( nv, jpoce, jpksed, zrearat, zundsat ) 
    458  
    459  
    460       ! New dissolved concentrations       
    461       DO jk = 1, jpksed 
    462          DO ji = 1, jpoce                       
    463             pwcp(ji,jk,jwdic) = zundsat(ji,jk,1) 
    464             pwcp(ji,jk,jwalk) = zundsat(ji,jk,2) 
    465             pwcp(ji,jk,jwc13) = zundsat(ji,jk,3) 
    466          ENDDO 
    467       ENDDO             
    468        
    469       !---------------------------------- 
    470       !   Back to initial geometry 
    471       !----------------------------- 
    472        
    473       !--------------------------------------------------------------------- 
    474       !   1/ Compensation for ajustement of the bottom water concentrations 
    475       !      (see note n° 1 about *por(2)) 
     387            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + zreasat * ( srno3 * zadsnh4 - 2.* spo4r ) + 8.0 * zreasat 
     388            ! Ammonium 
     389            pwcp(ji,jk,jwnh4)  = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 
     390            pwcp(ji,jk,jwfe2)  = pwcp(ji,jk,jwfe2) + zreasat * 4.0 
     391         ENDDO 
     392      ENDDO 
     393 
    476394      !-------------------------------------------------------------------- 
    477       DO jw = 1, jpwat 
    478          DO ji = 1, jpoce 
    479             pwcp(ji,1,jw) = pwcp(ji,1,jw) + & 
    480                &            pwcp(ji,2,jw) * dzdep(ji) * por(2) / dzkbot(ji) 
    481          END DO 
    482       ENDDO 
    483        
    484       !----------------------------------------------------------------------- 
    485       !    2/ Det of new rainrg taking account of the new weight fraction obtained  
    486       !      in dz3d(2) after diffusion/reaction (react/diffu are also in dzdep!) 
    487       !      This new rain (rgntg rm) will be used in advection/burial routine 
    488       !------------------------------------------------------------------------ 
    489       DO js = 1, jpsol 
    490          DO ji = 1, jpoce 
    491             rainrg(ji,js) = raintg(ji) * solcp(ji,2,js) 
    492             rainrm(ji,js) = rainrg(ji,js) / mol_wgt(js) 
    493          END DO 
    494       ENDDO 
    495        
    496       !  New raintg 
    497       raintg(:) = 0. 
    498       DO js = 1, jpsol 
    499          DO ji = 1, jpoce 
    500             raintg(ji) = raintg(ji) + rainrg(ji,js) 
    501          END DO 
    502       ENDDO 
    503        
    504       !-------------------------------- 
    505       !    3/ back to initial geometry 
    506       !-------------------------------- 
     395      ! Begining POC denitrification and NO3- diffusion 
     396      ! (indice n�5 for couple POC/NO3- ie solcp(:,:,jspoc)/pwcp(:,:,jwno3)) 
     397      !-------------------------------------------------------------------- 
     398 
     399      zrearat1(:,:) = 0. 
     400      zrearat2(:,:) = 0. 
     401      zrearat3(:,:) = 0. 
     402 
     403      zundsat(:,:) = pwcp(:,:,jwso4) 
     404 
     405      DO jk = 2, jpksed 
     406         DO ji = 1, jpoce 
     407            zlimso4(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3)    & 
     408            &                / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) * ( 1. - solcp(ji,jk,jsfeo)  & 
     409            &                / ( solcp(ji,jk,jsfeo) + xksedfeo ) ) / ( zundsat(ji,jk) + xksedso4 ) 
     410            zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 
     411            zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 
     412            zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 
     413            zkpoca = zkpoc(ji,jk) * zlimso4(ji,jk) 
     414            zkpocb = zkpos(ji,jk) * zlimso4(ji,jk) 
     415            zkpocc = zkpor(ji,jk) * zlimso4(ji,jk) 
     416            zrearat1(ji,jk)  = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     417            &                 ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 
     418            zrearat2(ji,jk)  = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     419            &                 ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 
     420            zrearat3(ji,jk)  = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     421            &                 ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 
     422        END DO 
     423      END DO 
     424! 
     425!      DO jn = 1, 5  
     426      DO jk = 2, jpksed 
     427         DO ji = 1, jpoce 
     428jflag4:     DO jn = 1, 10 
     429               zlimtmp = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3)    & 
     430               &         / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) * ( 1. - solcp(ji,jk,jsfeo)  & 
     431               &         / ( solcp(ji,jk,jsfeo) + xksedfeo ) )  
     432               zsolid1 = zvolc(ji,jk,jspoc) * solcp(ji,jk,jspoc) 
     433               zsolid2 = zvolc(ji,jk,jspos) * solcp(ji,jk,jspos) 
     434               zsolid3 = zvolc(ji,jk,jspor) * solcp(ji,jk,jspor) 
     435               zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) )  
     436               zbeta   = xksedso4 - pwcp(ji,jk,jwso4) + 0.5 * zreasat * zlimtmp 
     437               zgamma = - xksedso4 * pwcp(ji,jk,jwso4) 
     438               zundsat2 = zundsat(ji,jk) 
     439               zundsat(ji,jk) = ( - zbeta + SQRT( zbeta**2 - 4.0 * zgamma ) ) / 2.0 
     440               zlimso4(ji,jk) = ( 1.0 - pwcp(ji,jk,jwoxy) * zlimo2(ji,jk) ) * ( 1.0 - pwcp(ji,jk,jwno3)    & 
     441               &                / ( pwcp(ji,jk,jwno3) + xksedno3 ) ) * ( 1. - solcp(ji,jk,jsfeo)  & 
     442               &                / ( solcp(ji,jk,jsfeo) + xksedfeo ) ) / ( zundsat(ji,jk) + xksedso4 ) 
     443               zkpoca  = zkpoc(ji,jk) * zlimso4(ji,jk) 
     444               zkpocb  = zkpos(ji,jk) * zlimso4(ji,jk) 
     445               zkpocc  = zkpor(ji,jk) * zlimso4(ji,jk) 
     446               zrearat1(ji,jk)  = ( zkpoc(ji,jk) * dtsed2 * zsolid1 ) / & 
     447               &                 ( 1. + zkpoca * zundsat(ji,jk ) * dtsed2 ) 
     448               zrearat2(ji,jk)  = ( zkpos(ji,jk) * dtsed2 * zsolid2 ) / & 
     449               &                 ( 1. + zkpocb * zundsat(ji,jk ) * dtsed2 ) 
     450               zrearat3(ji,jk)  = ( zkpor(ji,jk) * dtsed2 * zsolid3 ) / & 
     451               &                 ( 1. + zkpocc * zundsat(ji,jk ) * dtsed2 ) 
     452               IF ( ABS( (zundsat(ji,jk)-zundsat2)/(zundsat2+rtrn)) < 1E-8 ) THEN 
     453                  EXIT jflag4 
     454               ENDIF 
     455            END DO jflag4 
     456         END DO 
     457      END DO 
     458 
     459     ! New solid concentration values (jk=2 to jksed) for each couple  
     460      DO jk = 2, jpksed 
     461         DO ji = 1, jpoce 
     462            zreasat = zrearat1(ji,jk) * zlimso4(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspoc) 
     463            solcp(ji,jk,jspoc) = solcp(ji,jk,jspoc) - zreasat 
     464            zreasat = zrearat2(ji,jk) * zlimso4(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspos) 
     465            solcp(ji,jk,jspos) = solcp(ji,jk,jspos) - zreasat 
     466            zreasat = zrearat3(ji,jk) * zlimso4(ji,jk) * zundsat(ji,jk) / zvolc(ji,jk,jspor) 
     467            solcp(ji,jk,jspor) = solcp(ji,jk,jspor) - zreasat 
     468         ENDDO 
     469      ENDDO 
     470! 
     471      ! New dissolved concentrations 
     472      DO jk = 2, jpksed 
     473         DO ji = 1, jpoce 
     474            ! For sulfur 
     475            pwcp(ji,jk,jwh2s)  = pwcp(ji,jk,jwh2s) - ( zundsat(ji,jk) - pwcp(ji,jk,jwso4) )  
     476            pwcp(ji,jk,jwso4)  =  zundsat(ji,jk) 
     477            zreasat = ( zrearat1(ji,jk) + zrearat2(ji,jk) + zrearat3(ji,jk) ) * zlimso4(ji,jk) * zundsat(ji,jk) 
     478            ! For DIC 
     479            pwcp(ji,jk,jwdic)  = pwcp(ji,jk,jwdic) + zreasat 
     480            zsumtot(ji) = zsumtot(ji) + zreasat / dtsed2 * volw3d(ji,jk) * 1.e-3 * 86400. * 365. * 1E3 
     481            ! For Phosphate (in mol/l) 
     482            pwcp(ji,jk,jwpo4)  = pwcp(ji,jk,jwpo4) + zreasat * spo4r 
     483            ! Ligands 
     484            sedligand(ji,jk)   = sedligand(ji,jk) + ratligc * zreasat 
     485            ! For iron (in mol/l) 
     486            pwcp(ji,jk,jwfe2)  = pwcp(ji,jk,jwfe2) + fecratio(ji) * zreasat 
     487            ! For alkalinity 
     488            pwcp(ji,jk,jwalk)  = pwcp(ji,jk,jwalk) + zreasat * ( srno3 * zadsnh4 - 2.* spo4r ) + zreasat 
     489            ! Ammonium 
     490            pwcp(ji,jk,jwnh4)  = pwcp(ji,jk,jwnh4) + zreasat * srno3 * zadsnh4 
     491         ENDDO 
     492      ENDDO 
     493 
     494      ! Oxydation of the reduced products. Here only ammonium and ODU is accounted for 
     495      ! There are two options here: A simple time splitting scheme and a modified  
     496     ! Patankar scheme 
     497      ! ------------------------------------------------------------------------------ 
     498 
     499      call sed_dsr_redoxb 
     500 
     501      ! --------------------------------------------------------------  
     502      !    4/ Computation of the bioturbation coefficient 
     503      !       This parameterization is taken from Archer et al. (2002) 
     504      ! -------------------------------------------------------------- 
     505 
    507506      DO ji = 1, jpoce 
    508          dz3d  (ji,2) = dz(2) 
    509          volw3d(ji,2) = dz3d(ji,2) * por(2) 
    510          vols3d(ji,2) = dz3d(ji,2) * por1(2) 
    511       ENDDO 
    512        
    513       !---------------------------------------------------------------------- 
    514       !    4/ Saving new amount of material in dzkbot for mass balance check 
    515       !       tokbot in [mol] (implicit *1cm*1cm for spacial dim) 
    516       !---------------------------------------------------------------------- 
    517       DO jw = 1, jpwat  
    518          DO ji = 1, jpoce 
    519             tokbot(ji,jw) = pwcp(ji,1,jw) * 1.e-3 * dzkbot(ji) 
    520          END DO 
    521       ENDDO 
    522  
    523       DEALLOCATE( zmo2_0  ) ;  DEALLOCATE( zmno3_1 )  ;  DEALLOCATE( zmno3_2 )  
    524       DEALLOCATE( zmc13_0 ) ;  DEALLOCATE( zmc13_1 )  ;  DEALLOCATE( zmc13_2 ) ;  DEALLOCATE( zmc13_3 )  
    525        
    526       DEALLOCATE( zrearat ) ;  DEALLOCATE( zundsat )  ;  DEALLOCATE( zvolc )    
    527        
     507         db(ji,:) = dbiot * zsumtot(ji) * pwcp(ji,1,jwoxy) / (pwcp(ji,1,jwoxy) + 20.E-6) 
     508      END DO 
     509 
     510      ! ------------------------------------------------------ 
     511      !    Vertical variations of the bioturbation coefficient 
     512      ! ------------------------------------------------------ 
     513      IF (ln_btbz) THEN 
     514         DO ji = 1, jpoce 
     515            db(ji,:) = db(ji,:) * exp( -(profsedw(:) / dbtbzsc)**2 ) / (365.0 * 86400.0) 
     516         END DO 
     517      ELSE 
     518         DO jk = 1, jpksed 
     519            IF (profsedw(jk) > dbtbzsc) THEN 
     520                db(:,jk) = 0.0 
     521            ENDIF 
     522         END DO 
     523      ENDIF 
     524 
     525      IF (ln_irrig) THEN 
     526         DO jk = 1, jpksed 
     527            DO ji = 1, jpoce 
     528               irrig(ji,jk) = ( 7.63752 - 7.4465 * exp( -0.89603 * zsumtot(ji) ) ) * pwcp(ji,1,jwoxy)  & 
     529               &             / (pwcp(ji,1,jwoxy) + 20.E-6)  
     530               irrig(ji,jk) = irrig(ji,jk) * exp( -(profsedw(jk) / xirrzsc) ) 
     531            END DO 
     532         END DO 
     533      ELSE 
     534         irrig(:,:) = 0.0 
     535      ENDIF 
     536 
     537      DEALLOCATE( zvolc ) 
     538 
     539      IF( ln_timing )  CALL timing_stop('sed_dsr') 
     540!       
    528541   END SUBROUTINE sed_dsr 
    529 #else 
    530    !!====================================================================== 
    531    !! MODULE seddsr  :   Dummy module  
    532    !!====================================================================== 
    533    !! $Id$ 
    534 CONTAINS 
    535    SUBROUTINE sed_dsr ( kt ) 
    536      INTEGER, INTENT(in) :: kt 
    537      WRITE(*,*) 'sed_dsr: You should not have seen this print! error?', kt 
    538   END SUBROUTINE sed_dsr 
    539 #endif 
    540     
     542 
     543   SUBROUTINE sed_dsr_redoxb 
     544      !!---------------------------------------------------------------------- 
     545      !!                   ***  ROUTINE sed_dsr_redox  *** 
     546      !!  
     547      !!  ** Purpose :  computes secondary redox reactions 
     548      !! 
     549      !!  ** Methode :  It uses Strand splitter algorithm proposed by  
     550      !!                Nguyen et al. (2009) and modified by Wang et al. (2018) 
     551      !!                Basically, each equation is solved analytically when  
     552      !!                feasible, otherwise numerically at t+1/2. Then  
     553      !!                the last equation is solved at t+1. The other equations 
     554      !!                are then solved at t+1 starting in the reverse order. 
     555      !!                Ideally, it's better to start from the fastest reaction 
     556      !!                to the slowest and then reverse the order to finish up 
     557      !!                with the fastest one. But random order works well also. 
     558      !!                The scheme is second order, positive and mass  
     559      !!                conserving. It works well for stiff systems. 
     560      !!  
     561      !!   History : 
     562      !!        !  18-08 (O. Aumont)  Original code 
     563      !!---------------------------------------------------------------------- 
     564      !! Arguments 
     565      ! --- local variables 
     566      INTEGER   ::  ji, jk, jn   ! dummy looop indices 
     567 
     568      REAL, DIMENSION(6)  :: zsedtrn, zsedtra 
     569      REAL(wp)  ::  zalpha, zbeta, zgamma, zdelta, zepsi, zsedfer 
     570      !! 
     571      !!---------------------------------------------------------------------- 
     572 
     573      IF( ln_timing )  CALL timing_start('sed_dsr_redoxb') 
     574 
     575      DO ji = 1, jpoce 
     576         DO jk = 2, jpksed 
     577            zsedtrn(1)  = pwcp(ji,jk,jwoxy) 
     578            zsedtrn(2)  = MAX(0., pwcp(ji,jk,jwh2s) ) 
     579            zsedtrn(3)  = pwcp(ji,jk,jwnh4) 
     580            zsedtrn(4)  = MAX(0., pwcp(ji,jk,jwfe2) - sedligand(ji,jk) ) 
     581            zsedfer     = MIN(0., pwcp(ji,jk,jwfe2) - sedligand(ji,jk) ) 
     582            zsedtrn(5)  = solcp(ji,jk,jsfeo) * zvolc(ji,jk,jsfeo) 
     583            zsedtrn(6)  = solcp(ji,jk,jsfes) * zvolc(ji,jk,jsfes) 
     584            zsedtra(:)  = zsedtrn(:)  
     585 
     586            ! First pass of the scheme. At the end, it is 1st order  
     587            ! ----------------------------------------------------- 
     588            ! Fe + O2 
     589            zalpha = zsedtra(1) - 0.25 * zsedtra(4) 
     590            zbeta  = zsedtra(4) + zsedtra(5)  
     591            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 
     592            zdelta = pwcp(ji,jk,jwpo4) - redfep * zsedtra(4) 
     593            zsedtra(4) = ( zsedtra(4) * zalpha ) / ( 0.25 * zsedtra(4) * ( exp( reac_fe2 * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     594            &            + zalpha * exp( reac_fe2 * zalpha * dtsed2 / 2. ) + rtrn ) 
     595            zsedtra(1) = zalpha + 0.25 * zsedtra(4)  
     596            zsedtra(5) = zbeta  - zsedtra(4) 
     597            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 
     598            pwcp(ji,jk,jwpo4) = zdelta + redfep * zsedtra(4) 
     599            ! H2S + O2 
     600            zalpha = zsedtra(1) - 2.0 * zsedtra(2) 
     601            zbeta  = pwcp(ji,jk,jwso4) + zsedtra(2) 
     602            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(2) 
     603            zsedtra(2) = ( zsedtra(2) * zalpha ) / ( 2.0 * zsedtra(2) * ( exp( reac_h2s * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     604            &            + zalpha * exp( reac_h2s * zalpha * dtsed2 / 2. ) + rtrn ) 
     605            zsedtra(1) = zalpha + 2.0 * zsedtra(2) 
     606            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(2) 
     607            pwcp(ji,jk,jwso4) = zbeta - zsedtra(2) 
     608            ! NH4 + O2 
     609            zalpha = zsedtra(1) - 2.0 * zsedtra(3) 
     610            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(3) 
     611            zsedtra(3) = ( zsedtra(3) * zalpha ) / ( 2.0 * zsedtra(3) * ( exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     612            &            + zalpha * exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 /2. ) + rtrn ) 
     613            zsedtra(1) = zalpha + 2.0 * zsedtra(3) 
     614            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(3) 
     615            ! FeS - O2 
     616            zalpha = zsedtra(1) - 2.0 * zsedtra(6) 
     617            zbeta  = zsedtra(4) + zsedtra(6) 
     618            zgamma = pwcp(ji,jk,jwso4) + zsedtra(6) 
     619            zsedtra(6) = ( zsedtra(6) * zalpha ) / ( 2.0 * zsedtra(6) * ( exp( reac_feso * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     620            &            + zalpha * exp( reac_feso * zalpha * dtsed2 /2. ) + rtrn ) 
     621            zsedtra(1) = zalpha + 2.0 * zsedtra(6) 
     622            zsedtra(4) = zbeta  - zsedtra(6) 
     623            pwcp(ji,jk,jwso4) = zgamma - zsedtra(6) 
     624!            ! Fe - H2S 
     625            zalpha = zsedtra(2) - zsedtra(4) 
     626            zbeta  = zsedtra(4) + zsedtra(6) 
     627            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 
     628            zsedtra(4) = ( zsedtra(4) * zalpha ) / ( zsedtra(4) * ( exp( reac_fes * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     629            &            + zalpha * exp( reac_fes * zalpha * dtsed2 /2. ) + rtrn ) 
     630            zsedtra(2) = zalpha + zsedtra(4) 
     631            zsedtra(6) = zbeta  - zsedtra(4) 
     632            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 
     633            ! FEOH + H2S 
     634            zalpha = zsedtra(5) - 2.0 * zsedtra(2) 
     635            zbeta  = zsedtra(5) + zsedtra(4) 
     636            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 
     637            zdelta = pwcp(ji,jk,jwso4) + zsedtra(2) 
     638            zepsi  = pwcp(ji,jk,jwpo4) + redfep * zsedtra(5) 
     639            zsedtra(2) = ( zsedtra(2) * zalpha ) / ( 2.0 * zsedtra(2) * ( exp( reac_feh2s * zalpha * dtsed2 ) - 1.0 )  & 
     640            &            + zalpha * exp( reac_feh2s * zalpha * dtsed2 ) + rtrn ) 
     641            zsedtra(5) = zalpha + 2.0 * zsedtra(2) 
     642            zsedtra(4) = zbeta  - zsedtra(5) 
     643            pwcp(ji,jk,jwso4) = zdelta - zsedtra(2) 
     644            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 
     645            pwcp(ji,jk,jwpo4) = zepsi - redfep * zsedtra(5) 
     646            ! Fe - H2S 
     647            zalpha = zsedtra(2) - zsedtra(4) 
     648            zbeta  = zsedtra(4) + zsedtra(6) 
     649            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 
     650            zsedtra(4) = ( zsedtra(4) * zalpha ) / ( zsedtra(4) * ( exp( reac_fes * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     651            &            + zalpha * exp( reac_fes * zalpha * dtsed2 /2. ) + rtrn ) 
     652            zsedtra(2) = zalpha + zsedtra(4) 
     653            zsedtra(6) = zbeta  - zsedtra(4) 
     654            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 
     655            ! FeS - O2 
     656            zalpha = zsedtra(1) - 2.0 * zsedtra(6) 
     657            zbeta  = zsedtra(4) + zsedtra(6) 
     658            zgamma = pwcp(ji,jk,jwso4) + zsedtra(6) 
     659            zsedtra(6) = ( zsedtra(6) * zalpha ) / ( 2.0 * zsedtra(6) * ( exp( reac_feso * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     660            &            + zalpha * exp( reac_feso * zalpha * dtsed2 /2. ) + rtrn ) 
     661            zsedtra(1) = zalpha + 2.0 * zsedtra(6) 
     662            zsedtra(4) = zbeta  - zsedtra(6) 
     663            pwcp(ji,jk,jwso4) = zgamma - zsedtra(6) 
     664            ! NH4 + O2 
     665            zalpha = zsedtra(1) - 2.0 * zsedtra(3) 
     666            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(3) 
     667            zsedtra(3) = ( zsedtra(3) * zalpha ) / ( 2.0 * zsedtra(3) * ( exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     668            &            + zalpha * exp( reac_nh4 * zadsnh4 * zalpha * dtsed2 /2. ) + rtrn ) 
     669            zsedtra(1) = zalpha + 2.0 * zsedtra(3) 
     670            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(3) 
     671            ! H2S + O2 
     672            zalpha = zsedtra(1) - 2.0 * zsedtra(2) 
     673            zbeta  = pwcp(ji,jk,jwso4) + zsedtra(2) 
     674            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(2) 
     675            zsedtra(2) = ( zsedtra(2) * zalpha ) / ( 2.0 * zsedtra(2) * ( exp( reac_h2s * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     676            &            + zalpha * exp( reac_h2s * zalpha * dtsed2 / 2. ) + rtrn ) 
     677            zsedtra(1) = zalpha + 2.0 * zsedtra(2) 
     678            pwcp(ji,jk,jwso4) = zbeta - zsedtra(2) 
     679            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(2) 
     680            ! Fe + O2 
     681            zalpha = zsedtra(1) - 0.25 * zsedtra(4) 
     682            zbeta  = zsedtra(4) + zsedtra(5) 
     683            zgamma = pwcp(ji,jk,jwalk) - 2.0 * zsedtra(4) 
     684            zdelta = pwcp(ji,jk,jwpo4) - redfep * zsedtra(4) 
     685            zsedtra(4) = ( zsedtra(4) * zalpha ) / ( 0.25 * zsedtra(4) * ( exp( reac_fe2 * zalpha * dtsed2 / 2. ) - 1.0 )  & 
     686            &            + zalpha * exp( reac_fe2 * zalpha * dtsed2 / 2. ) + rtrn ) 
     687            zsedtra(1) = zalpha + 0.25 * zsedtra(4) 
     688            zsedtra(5) = zbeta  - zsedtra(4) 
     689            pwcp(ji,jk,jwpo4) = zdelta + redfep * zsedtra(4) 
     690            pwcp(ji,jk,jwalk) = zgamma + 2.0 * zsedtra(4) 
     691            pwcp(ji,jk,jwoxy)  = zsedtra(1) 
     692            pwcp(ji,jk,jwh2s)  = zsedtra(2) 
     693            pwcp(ji,jk,jwnh4)  = zsedtra(3) 
     694            pwcp(ji,jk,jwfe2)  = zsedtra(4) + sedligand(ji,jk) + zsedfer 
     695            pwcp(ji,jk,jwno3)  = pwcp(ji,jk,jwno3)  + ( zsedtrn(3) - pwcp(ji,jk,jwnh4) ) 
     696            solcp(ji,jk,jsfeo) = zsedtra(5) / zvolc(ji,jk,jsfeo) 
     697            solcp(ji,jk,jsfes) = zsedtra(6) / zvolc(ji,jk,jsfes) 
     698         END DO 
     699      END DO 
     700 
     701      IF( ln_timing )  CALL timing_stop('sed_dsr_redoxb') 
     702 
     703  END SUBROUTINE sed_dsr_redoxb 
     704 
    541705END MODULE seddsr 
  • NEMO/trunk/src/TOP/PISCES/SED/seddta.F90

    r7646 r10222  
    44   !! Sediment data  :  read sediment input data from a file 
    55   !!===================================================================== 
    6 #if defined key_sed 
     6 
    77   !! * Modules used 
    88   USE sed 
    99   USE sedarr 
    1010   USE iom 
     11   USE lib_mpp         ! distribued memory computing library 
    1112 
    1213   IMPLICIT NONE 
     
    1718 
    1819   !! *  Module variables 
    19    REAL(wp), DIMENSION(:), ALLOCATABLE ::  smask       ! mask for sediments points 
    2020   REAL(wp) ::  rsecday  ! number of second per a day 
    21    REAL(wp) ::  conv1    ! [m/day]--->[cm/s]   
    2221   REAL(wp) ::  conv2    ! [kg/m2/month]-->[g/cm2/s] ( 1 month has 30 days ) 
    23  
    24    INTEGER ::  numbio 
    25  
    26 #if defined key_sed_off 
    27    INTEGER ::  numoce 
    28 #endif 
    2922 
    3023   !! $Id$ 
     
    5447      INTEGER  ::  ji, jj, js, jw, ikt 
    5548 
    56       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdta 
    57       REAL(wp), DIMENSION(:)  , ALLOCATABLE :: zdtap, zdtag 
    58  
     49      REAL(wp), DIMENSION(jpoce) :: zdtap, zdtag 
     50      REAL(wp), DIMENSION(jpi,jpj) :: zwsbio4, zwsbio3, zwscal 
     51      REAL(wp) :: zf0, zf1, zf2, zkapp, zratio, zdep 
    5952 
    6053      !---------------------------------------------------------------------- 
     
    6457      !------------------------------------------------------------- 
    6558 
    66       WRITE(numsed,*) 
    67       WRITE(numsed,*) ' sed_dta : Bottom layer fields' 
    68       WRITE(numsed,*) ' ~~~~~~' 
    69       WRITE(numsed,*) ' Data from SMS model' 
    70       WRITE(numsed,*) 
     59      IF( ln_timing )  CALL timing_start('sed_dta') 
     60 
     61      IF (lwp) THEN 
     62         WRITE(numsed,*) 
     63         WRITE(numsed,*) ' sed_dta : Bottom layer fields' 
     64         WRITE(numsed,*) ' ~~~~~~' 
     65         WRITE(numsed,*) ' Data from SMS model' 
     66         WRITE(numsed,*) 
     67      ENDIF 
    7168 
    7269 
    7370      ! open file 
    7471      IF( kt == nitsed000 ) THEN 
    75          WRITE(numsed,*) ' sed_dta : Sediment fields' 
    76          CALL iom_open ( 'data_bio_bot'     , numbio ) 
    77 #if defined key_sed_off 
    78          CALL iom_open( 'data_oce_bot', numoce) 
    79 #endif 
     72         IF (lwp) WRITE(numsed,*) ' sed_dta : Sediment fields' 
     73         dtsed = r2dttrc 
    8074         rsecday = 60.* 60. * 24. 
    81          conv1   = 1.0e+2 / rsecday  
    82          conv2   = 1.0e+3 / ( 1.0e+4 * rsecday * 30. )  
    83  
    84          ! Compute sediment mask 
    85          ALLOCATE( zdta(jpi,jpj) )  
     75!         conv2   = 1.0e+3 / ( 1.0e+4 * rsecday * 30. ) 
     76         conv2 = 1.0e+3 /  1.0e+4  
     77         rdtsed(2:jpksed) = dtsed / ( denssol * por1(2:jpksed) ) 
     78      ENDIF 
     79 
     80      ! Initialization of temporaries arrays   
     81      zdtap(:)    = 0.  
     82      zdtag(:)    = 0.   
     83 
     84      ! reading variables 
     85      IF (lwp) WRITE(numsed,*) 
     86      IF (lwp) WRITE(numsed,*) ' sed_dta : Bottom layer fields at time  kt = ', kt 
     87      ! reading variables 
     88      ! 
     89      !    Sinking speeds of detritus is increased with depth as shown 
     90      !    by data and from the coagulation theory 
     91      !    ----------------------------------------------------------- 
     92      IF (ln_sediment_offline) THEN 
    8693         DO jj = 1, jpj 
    8794            DO ji = 1, jpi 
    88                ikt = MAX( INT( sbathy(ji,jj) ) - 1, 1 ) 
    89                zdta(ji,jj) = tmask(ji,jj,ikt)  
    90             ENDDO 
    91          ENDDO 
    92          ALLOCATE( smask(jpoce) ) 
    93          smask(:) = 0. 
    94          CALL pack_arr( jpoce, smask(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 
    95       ENDIF 
    96  
    97       ! Initialization of temporaries arrays   
    98       ALLOCATE( zdtap(jpoce) )    ;   zdtap(:)    = 0.  
    99       ALLOCATE( zdtag(jpoce) )    ;   zdtag(:)    = 0.   
    100  
    101       IF( MOD( kt - 1, nfreq ) == 0 ) THEN 
    102          ! reading variables 
    103          WRITE(numsed,*) 
    104          WRITE(numsed,*) ' sed_dta : Bottom layer fields at time  kt = ', kt 
    105          ! reading variables 
    106          trc_data(:,:,:) = 0. 
    107 #if ! defined key_sed_off 
    108          DO jj = 1,jpj 
     95               ikt = mbkt(ji,jj) 
     96               zwsbio4(ji,jj) = wsbio2 / rday 
     97               zwsbio3(ji,jj) = wsbio  / rday 
     98               zwscal (ji,jj) = wsbio2 / rday 
     99            END DO 
     100         END DO 
     101      ELSE 
     102         DO jj = 1, jpj 
    109103            DO ji = 1, jpi 
    110104               ikt = mbkt(ji,jj) 
    111                IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    112                   trc_data(ji,jj,1)  = trn  (ji,jj,ikt,jptal) 
    113                   trc_data(ji,jj,2)  = trn  (ji,jj,ikt,jpdic) 
    114                   trc_data(ji,jj,3)  = trn  (ji,jj,ikt,jpno3) / 7.6 
    115                   trc_data(ji,jj,4)  = trn  (ji,jj,ikt,jppo4) / 122. 
    116                   trc_data(ji,jj,5)  = trn  (ji,jj,ikt,jpoxy) 
    117                   trc_data(ji,jj,6)  = trn  (ji,jj,ikt,jpsil) 
    118                   trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 
    119                   trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) 
    120                   trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt) 
    121                   trc_data(ji,jj,10) = sinkcal (ji,jj,ikt) 
    122                   trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_tem) 
    123                   trc_data(ji,jj,12) = tsn     (ji,jj,ikt,jp_sal) 
    124                ENDIF 
    125             ENDDO 
     105               zdep = e3t_n(ji,jj,ikt) / r2dttrc 
     106               zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 
     107               zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) / rday ) 
     108               zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 
     109            END DO 
     110         END DO 
     111      ENDIF 
     112 
     113      trc_data(:,:,:) = 0. 
     114      DO jj = 1,jpj 
     115         DO ji = 1, jpi 
     116            ikt = mbkt(ji,jj) 
     117            IF ( tmask(ji,jj,ikt) == 1 ) THEN 
     118               trc_data(ji,jj,1)   = trb(ji,jj,ikt,jpsil) 
     119               trc_data(ji,jj,2)   = trb(ji,jj,ikt,jpoxy) 
     120               trc_data(ji,jj,3)   = trb(ji,jj,ikt,jpdic) 
     121               trc_data(ji,jj,4)   = trb(ji,jj,ikt,jpno3) / 7.625 
     122               trc_data(ji,jj,5)   = trb(ji,jj,ikt,jppo4) / 122. 
     123               trc_data(ji,jj,6)   = trb(ji,jj,ikt,jptal) 
     124               trc_data(ji,jj,7)   = trb(ji,jj,ikt,jpnh4) / 7.625 
     125               trc_data(ji,jj,8)   = 0.0 
     126               trc_data(ji,jj,9)   = 28.0E-3 
     127               trc_data(ji,jj,10)  = trb(ji,jj,ikt,jpfer) 
     128               trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3 
     129               trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3 
     130               trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3 
     131               trc_data(ji,jj,14)  = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwscal (ji,jj) * 1E3 
     132               trc_data(ji,jj,15)  = tsn(ji,jj,ikt,jp_tem) 
     133               trc_data(ji,jj,16)  = tsn(ji,jj,ikt,jp_sal) 
     134               trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe)  & 
     135               &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
     136               trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 
     137            ENDIF 
    126138         ENDDO 
    127  
    128 #else 
    129          CALL iom_get( numbio, jpdom_data, 'ALKBOT'     , trc_data(:,:,1 ) ) 
    130          CALL iom_get( numbio, jpdom_data, 'DICBOT'     , trc_data(:,:,2 ) ) 
    131          CALL iom_get( numbio, jpdom_data, 'NO3BOT'     , trc_data(:,:,3 ) ) 
    132          CALL iom_get( numbio, jpdom_data, 'PO4BOT'     , trc_data(:,:,4 ) ) 
    133          CALL iom_get( numbio, jpdom_data, 'O2BOT'      , trc_data(:,:,5 ) ) 
    134          CALL iom_get( numbio, jpdom_data, 'SIBOT'      , trc_data(:,:,6 ) ) 
    135          CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) )  
    136          CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) )  
    137          CALL iom_get( numbio, jpdom_data, 'GOCFLXBOT'  , trc_data(:,:,9 ) )  
    138          CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,10) )  
    139          CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,11) )  
    140          CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,12) )  
    141 #endif 
    142  
    143          ! Pore water initial concentration [mol/l] in  k=1 
    144          !------------------------------------------------- 
    145  
    146           ! Alkalinity ( 1 umol = 10-6equivalent ) 
    147          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwalk), trc_data(1:jpi,1:jpj,1), iarroce(1:jpoce) ) 
    148          ! DIC  
    149          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwdic), trc_data(1:jpi,1:jpj,2), iarroce(1:jpoce) ) 
    150          ! Nitrates (1 umol/l = 10-6 mol/l) 
    151          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwno3), trc_data(1:jpi,1:jpj,3), iarroce(1:jpoce) ) 
    152          ! Phosphates (1 umol/l = 10-6 mol/l) 
    153          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwpo4), trc_data(1:jpi,1:jpj,4), iarroce(1:jpoce) ) 
    154          ! Oxygen (1 umol/l = 10-6 mol/l) 
    155          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwoxy), trc_data(1:jpi,1:jpj,5), iarroce(1:jpoce) )         
    156          ! Silicic Acid [mol.l-1] 
    157          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwsil), trc_data(1:jpi,1:jpj,6), iarroce(1:jpoce) )                   
    158          ! DIC13 (mol/l)obtained from dc13 and DIC (12) and PDB  
    159          CALL iom_get ( numbio,jpdom_data,'DC13',zdta(:,:) ) 
    160          CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jwc13), zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 
    161          pwcp_dta(1:jpoce,jwc13) = pdb * ( pwcp_dta(1:jpoce,jwc13) * 1.0e-3 + 1.0 )  & 
    162             &                          *   pwcp_dta(1:jpoce,jwdic)          
    163           
    164          !  Solid components :  
    165          !----------------------- 
    166          !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    167          CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) )  
    168          rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4 
    169          !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    170          CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )       
    171          CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,9) , iarroce(1:jpoce) ) 
    172          rainrm_dta(1:jpoce,jspoc) =   ( zdtap(1:jpoce) +  zdtag(1:jpoce) ) * 1e-4 
    173          !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    174          CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) ) 
    175          rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 
    176          ! vector temperature [°C] and salinity  
    177          CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 
    178          CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) ) 
    179          
    180          ! Clay rain rate in [mol/(cm**2.s)]  
    181          ! inputs data in [kg.m-2.mois-1] ---> 1e+3/(1e+4*60*24*60*60) [g.cm-2.s-1]    
    182          ! divided after by molecular weight g.mol-1       
    183          zdta(:,:)   = 0. 
    184          CALL iom_get( numbio, jpdom_data, 'CLAY', zdta(:,:) )  
    185          CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsclay) , zdta(1:jpi,1:jpj), iarroce(1:jpoce) )       
    186          rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay) 
    187  
    188       ENDIF 
     139      ENDDO 
     140 
     141      ! Pore water initial concentration [mol/l] in  k=1 
     142      !------------------------------------------------- 
     143      DO jw = 1, jpwat 
     144         CALL pack_arr ( jpoce,  pwcp_dta(1:jpoce,jw), trc_data(1:jpi,1:jpj,jw), iarroce(1:jpoce) ) 
     145      END DO 
     146      !  Solid components :  
     147      !----------------------- 
     148      !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
     149      CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )  
     150      rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4 
     151      !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
     152      CALL pack_arr ( jpoce, zdtap(1:jpoce), trc_data(1:jpi,1:jpj,12) , iarroce(1:jpoce) )       
     153      CALL pack_arr ( jpoce, zdtag(1:jpoce), trc_data(1:jpi,1:jpj,13) , iarroce(1:jpoce) ) 
     154      DO ji = 1, jpoce 
     155!        zkapp  = MIN( (1.0 - 0.02 ) * reac_poc, 3731.0 * max(100.0, zkbot(ji) )**(-1.011) / ( 365.0 * 24.0 * 3600.0 ) ) 
     156!        zkapp   = MIN( 0.98 * reac_poc, 100.0 * max(100.0, zkbot(ji) )**(-0.6) / ( 365.0 * 24.0 * 3600.0 ) ) 
     157!        zratio = ( ( 1.0 - 0.02 ) * reac_poc + 0.02 * reac_poc * 0. - zkapp) / ( ( 0.02 - 1.0 ) * reac_poc / 100. - 0.02 * reac_poc * 0. + zkapp ) 
     158!        zf1    = ( 0.02 * (reac_poc - reac_poc * 0.) + zkapp - reac_poc ) / ( reac_poc / 100. - reac_poc ) 
     159!        zf1    = MIN(0.98, MAX(0., zf1 ) ) 
     160         zf1    = 0.48 
     161         zf0    = 1.0 - 0.02 - zf1 
     162         zf2    = 0.02 
     163         rainrm_dta(ji,jspoc) =   ( zdtap(ji) +  zdtag(ji) ) * 1e-4 * zf0 
     164         rainrm_dta(ji,jspos) =   ( zdtap(ji) +  zdtag(ji) ) * 1e-4 * zf1 
     165         rainrm_dta(ji,jspor) =   ( zdtap(ji) +  zdtag(ji) ) * 1e-4 * zf2 
     166      END DO 
     167      !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
     168      CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,14), iarroce(1:jpoce) ) 
     169      rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 
     170      ! vector temperature [°C] and salinity  
     171      CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,15), iarroce(1:jpoce) ) 
     172      CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,16), iarroce(1:jpoce) ) 
     173       
     174      ! Clay rain rate in [mol/(cm**2.s)]  
     175      ! inputs data in [kg.m-2.sec-1] ---> 1e+3/(1e+4) [g.cm-2.s-1]    
     176      ! divided after by molecular weight g.mol-1       
     177      CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jsclay), dust(1:jpi,1:jpj), iarroce(1:jpoce) ) 
     178      rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * conv2 / mol_wgt(jsclay)   & 
     179      &                            + wacc(1:jpoce) * por1(2) * denssol / mol_wgt(jsclay) / ( rsecday * 365.0 ) 
     180      rainrm_dta(1:jpoce,jsclay) = rainrm_dta(1:jpoce,jsclay) * 0.965 
     181      rainrm_dta(1:jpoce,jsfeo)  = rainrm_dta(1:jpoce,jsclay) * mol_wgt(jsclay) / mol_wgt(jsfeo) * 0.035 / 0.965 
     182!    rainrm_dta(1:jpoce,jsclay) = 1.0E-4 * conv2 / mol_wgt(jsclay) 
     183 
     184      ! Iron monosulphide rain rates. Set to 0 
     185      rainrm_dta(1:jpoce,jsfes)  = 0.  
     186 
     187      ! Fe/C ratio in sinking particles that fall to the sediments 
     188      CALL pack_arr ( jpoce,  fecratio(1:jpoce), trc_data(1:jpi,1:jpj,17), iarroce(1:jpoce) ) 
     189 
     190      sedligand(:,1) = 1.E-9 
    189191 
    190192      ! sediment pore water at 1st layer (k=1) 
    191193      DO jw = 1, jpwat 
    192          pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) * smask(1:jpoce) 
     194         pwcp(1:jpoce,1,jw) = pwcp_dta(1:jpoce,jw) 
    193195      ENDDO 
    194196 
    195197      !  rain 
    196198      DO js = 1, jpsol 
    197          rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) * smask(1:jpoce) 
     199         rainrm(1:jpoce,js) = rainrm_dta(1:jpoce,js) 
    198200      ENDDO 
    199201 
     
    212214      dzdep(1:jpoce) = raintg(1:jpoce) * rdtsed(2)  
    213215 
    214  
    215       DEALLOCATE( zdta )  
    216       DEALLOCATE( zdtap    ) ;  DEALLOCATE( zdtag    )  
    217  
    218       IF( kt == nitsedend )   THEN 
    219          CALL iom_close ( numbio ) 
    220 #if defined key_sed_off 
    221          CALL iom_close ( numoce ) 
    222 #endif 
    223       ENDIF 
     216      IF( lk_iomput ) THEN 
     217          IF( iom_use("sflxclay" ) ) CALL iom_put( "sflxclay", dust(:,:) * conv2 * 1E4 ) 
     218          IF( iom_use("sflxcal" ) )  CALL iom_put( "sflxcal", trc_data(:,:,13) ) 
     219          IF( iom_use("sflxbsi" ) )  CALL iom_put( "sflxbsi", trc_data(:,:,10) ) 
     220          IF( iom_use("sflxpoc" ) )  CALL iom_put( "sflxpoc", trc_data(:,:,11) + trc_data(:,:,12) ) 
     221      ENDIF 
     222 
     223      IF( ln_timing )  CALL timing_stop('sed_dta') 
    224224       
    225225   END SUBROUTINE sed_dta 
    226226 
    227 #else 
    228    !!====================================================================== 
    229    !! MODULE seddta  :   Dummy module  
    230    !!====================================================================== 
    231    !! $Id$ 
    232 CONTAINS 
    233    SUBROUTINE sed_dta ( kt ) 
    234      INTEGER, INTENT(in) :: kt 
    235      WRITE(*,*) 'sed_stp: You should not have seen this print! error?', kt  
    236   END SUBROUTINE sed_dta 
    237 #endif 
    238  
    239227END MODULE seddta 
  • NEMO/trunk/src/TOP/PISCES/SED/sedini.F90

    r5215 r10222  
    44   !! Sediment : define sediment variables 
    55   !!===================================================================== 
    6 #if defined key_sed 
    76 
    87   !!---------------------------------------------------------------------- 
     
    1110   !! * Modules used 
    1211   USE sed     ! sediment global variable 
    13    USE seddta 
    14    USE sedrst 
    15    USE sedco3 
    16    USE sedchem 
     12   USE sed_oce 
    1713   USE sedarr 
     14   USE sedadv 
     15   USE trcdmp_sed 
     16   USE trcdta 
    1817   USE iom 
     18   USE lib_mpp         ! distribued memory computing library 
    1919 
    2020 
     
    2424   !! Module variables 
    2525   REAL(wp)    ::  & 
    26       sisat   =  800.  ,  &  !: saturation for si    [ mol.l-1] 
    27       claysat =    0.  ,  &  !: saturation for clay  [ mol.l-1] 
     26      sedzmin = 0.3    ,  &  !: Minimum vertical spacing 
     27      sedhmax = 10.0   ,  &  !: Maximum depth of the sediment 
     28      sedkth  = 5.0    ,  &  !: Default parameters 
     29      sedacr  = 3.0          !: Default parameters 
     30       
     31   REAL(wp)    ::  & 
     32      porsurf =  0.95  ,  &  !: Porosity at the surface 
     33      porinf  =  0.75  ,  &  !: Porosity at infinite depth 
     34      rhox    =  2.0         !: Vertical length scale of porosity variation  
     35 
     36   REAL(wp)    ::  & 
    2837      rcopal  =   40.  ,  &  !: reactivity for si    [l.mol-1.an-1] 
    29       rcclay  =    0.  ,  &  !: reactivity for clay  [l.mol-1.an-1] 
    3038      dcoef   =  8.e-6       !: diffusion coefficient (*por)   [cm**2/s] 
    3139 
     40   REAL(wp), PUBLIC    ::  & 
     41      redO2    =  172.  ,  &  !: Redfield coef for Oxygen 
     42      redNo3   =   16.  ,  &  !: Redfield coef for Nitrate 
     43      redPo4   =    1.  ,  &  !: Redfield coef for Phosphate 
     44      redC     =  122.  ,  &  !: Redfield coef for Carbon 
     45      redfep   =  0.175 ,  &  !: Ratio for iron bound phosphorus 
     46      rcorgl   =   50.  ,  &  !: reactivity for POC/O2 [l.mol-1.an-1]     
     47      rcorgs   =   0.5  ,  &  !: reactivity of the semi-labile component 
     48      rcorgr   =   1E-4 ,  &  !: reactivity of the refractory component 
     49      rcnh4    =   10E6 ,  &  !: reactivity for O2/NH4 [l.mol-1.an-1]   
     50      rch2s    =   1.E5 ,  &  !: reactivity for O2/ODU [l.mol-1.an-1]  
     51      rcfe2    =   5.E8 ,  &  !: reactivity for O2/Fe2+ [l.mol-1.an-1] 
     52      rcfeh2s  =   1.E4 ,  &  !: Reactivity for FEOH/H2S [l.mol-1.an-1] 
     53      rcfes    =   1.E5 ,  &  !: Reactivity for FE2+/H2S [l.mol-1.an-1] 
     54      rcfeso   =   3.E5 ,  &  !: Reactivity for FES/O2 [l.mol-1.an-1] 
     55      xksedo2  =   5E-6 ,  &  !: half-sturation constant for oxic remin. 
     56      xksedno3 =   5E-6 ,  &  !: half-saturation constant for denitrification 
     57      xksedfeo =   0.6  ,  & !: half-saturation constant for iron remin 
     58      xksedso4 =   2E-3       !: half-saturation constant for SO4 remin 
     59 
    3260   REAL(wp)    ::  & 
    33       redO2   =  172.  ,  &  !: Redfield coef for Oxygene 
    34       redNo3  =   16.  ,  &  !: Redfield coef for Nitrates 
    35       redPo4  =    1.  ,  &  !: Redfield coef for Phosphates 
    36       redC    =  122.  ,  &  !: Redfield coef for Carbone 
    37       redDnit =  97.6  ,  &  !: Redfield coef for denitrification     
    38       rcorg   =   50.  ,  &  !: reactivity for POC/O2 [l.mol-1.an-1]     
    39       o2seuil =    1.  ,  &  !: threshold O2 concentration for [mol.l-1]      
    40       rcorgN  =   50.       !: reactivity for POC/No3 [l.mol-1.an-1] 
    41  
    42    REAL(wp)    ::  & 
    43       rccal   = 1000.        !: reactivity for calcite         [l.mol-1.an-1] 
    44  
    45    REAL(wp)    ::  & 
    46       dbiot   = 15.          !: coefficient for bioturbation    [cm**2.(1000an-1)] 
    47  
    48    LOGICAL     :: & 
    49       ln_rst_sed = .TRUE.    !: initialisation from a restart file or not 
    50  
     61      rccal   = 1000.,      & !: reactivity for calcite         [l.mol-1.an-1] 
     62      rcligc  = 1.E-4         !: L/C ratio in POC 
     63 
     64   REAL(wp), PUBLIC    ::  dbiot   = 15. , &  !: coefficient for bioturbation    [cm**2.(n-1)] 
     65      dbtbzsc =  10.0  ,    &  !: Vertical scale of variation. If no variation, mixed layer in the sed [cm] 
     66      xirrzsc = 2.0            !: Vertical scale of irrigation variation. 
    5167   REAL(wp)    ::  & 
    5268      ryear = 365. * 24. * 3600. !:  1 year converted in second 
     69 
     70   REAL(wp), DIMENSION(jpwat), PUBLIC  :: diff1 
     71   DATA diff1/4.59E-6, 1.104E-5, 4.81E-6 , 9.78E-6, 3.58E-6, 4.01E-6, 9.8E-6, 9.73E-6, 5.0E-6, 3.31E-6 / 
     72 
     73   REAL(wp), DIMENSION(jpwat), PUBLIC  :: diff2 
     74   DATA diff2/1.74E-7, 4.47E-7, 2.51E-7, 3.89E-7, 1.77E-7, 2.5E-7, 3.89E-7, 3.06E-7, 2.5E-7, 1.5E-7 / 
     75 
     76 
    5377 
    5478   !! *  Routine accessibility 
     
    76100      !!        !  06-07  (C. Ethe)  Re-organization 
    77101      !!---------------------------------------------------------------------- 
    78       INTEGER :: ji, jj, ikt 
    79 #if defined key_sed_off 
    80       INTEGER  :: numblt          
    81       INTEGER  :: nummsh    
    82       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta 
    83 #endif 
     102      INTEGER :: ji, jj, ikt, ierr 
    84103      !!---------------------------------------------------------------------- 
    85104 
     
    90109      CALL ctl_opn( numsed, 'sediment.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    91110 
    92       WRITE(numsed,*) 
    93       WRITE(numsed,*) '                 L S C E - C E A' 
    94       WRITE(numsed,*) '                 SEDIMENT model' 
    95       WRITE(numsed,*) '                version 2.0  (2007) ' 
    96       WRITE(numsed,*) 
    97       WRITE(numsed,*) 
    98  
    99      
    100       WRITE(numsed,*) ' sed_init : Initialization of sediment module  ' 
    101       WRITE(numsed,*) ' ' 
    102  
    103       !                                ! Allocate LOBSTER arrays 
    104       IF( sed_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sed_ini: unable to allocate sediment model arrays' ) 
    105  
     111      IF (lwp) THEN 
     112         WRITE(numsed,*) 
     113         WRITE(numsed,*) '                 PISCES framework' 
     114         WRITE(numsed,*) '                 SEDIMENT model' 
     115         WRITE(numsed,*) '                version 3.0  (2018) ' 
     116         WRITE(numsed,*) 
     117         WRITE(numsed,*) 
     118      ENDIF 
     119 
     120      IF(lwp) WRITE(numsed,*) ' sed_init : Initialization of sediment module  ' 
     121      IF(lwp) WRITE(numsed,*) ' ' 
     122 
     123      ! Read sediment Namelist 
     124      !------------------------- 
     125      CALL sed_init_nam 
     126 
     127      ! Allocate SEDIMENT arrays 
     128      ierr =        sed_alloc() 
     129      ierr = ierr + sed_oce_alloc() 
     130      ierr = ierr + sed_adv_alloc()  
     131      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'sed_ini: unable to allocate sediment model arrays' ) 
    106132 
    107133      ! Determination of sediments number of points and allocate global variables 
    108 #if defined key_sed_off 
    109       ! Reading Netcdf Pisces file for deepest water layer thickness [m] 
    110       ! This data will be used as mask to merdge space in 1D vector 
    111       !---------------------------------------------------------------- 
    112  
    113       CALL iom_open ( 'mesh_mask'  , nummsh )    
    114       CALL iom_open ( 'e3tbot'     , numblt ) 
    115  
    116       ! mask sediment points for outputs 
    117       CALL iom_get( nummsh, jpdom_data, 'tmask' , tmask ) 
    118       CALL iom_get( nummsh, jpdom_data, 'mbathy', sbathy ) 
    119        
    120       ! longitude/latitude values 
    121       CALL iom_get ( nummsh, jpdom_data,'nav_lon', glamt(:,:) ) 
    122       CALL iom_get ( nummsh, jpdom_data,'nav_lat', gphit(:,:) ) 
    123      
    124       ! bottom layer thickness 
    125       ALLOCATE( zdta(jpi,jpj) ) 
    126       CALL iom_get  ( numblt, jpdom_data, 'E3TBOT', zdta(:,:) ) 
    127       epkbot(:,:) = 0. 
    128       DO jj = 1, jpj 
    129          DO ji = 1, jpi 
    130             ikt = MAX( INT( sbathy(ji,jj) ), 1 ) 
    131             IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = zdta(ji,jj) 
    132          ENDDO 
    133       ENDDO 
    134  
    135       CALL iom_close( nummsh )   
    136       CALL iom_close( numblt )  
    137  
    138       DEALLOCATE( zdta ) 
    139 #else 
    140  
    141134      epkbot(:,:) = 0. 
    142135      DO jj = 1, jpj 
     
    144137            ikt = mbkt(ji,jj)  
    145138            IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) 
     139            gdepbot(ji,jj) = gdepw_0(ji,jj,ikt) 
    146140         ENDDO 
    147141      ENDDO 
    148 #endif      
    149  
    150142 
    151143      ! computation of total number of ocean points 
    152144      !-------------------------------------------- 
    153       jpoce  = COUNT( epkbot(:,:) > 0. ) 
    154  
     145      sedmask = 0. 
     146      IF ( COUNT( epkbot(:,:) > 0. ) == 0 ) THEN  
     147          sedmask = 0. 
     148      ELSE 
     149          sedmask = 1. 
     150      ENDIF  
     151      jpoce  = MAX( COUNT( epkbot(:,:) > 0. ) , 1 ) 
    155152 
    156153      ! Allocate memory size of global variables 
     
    159156      ALLOCATE( rainrm(jpoce,jpsol) )        ;  ALLOCATE( rainrg(jpoce,jpsol) )        ;  ALLOCATE( raintg(jpoce) )  
    160157      ALLOCATE( dzdep(jpoce) )               ;  ALLOCATE( iarroce(jpoce) )             ;  ALLOCATE( dzkbot(jpoce) ) 
    161       ALLOCATE( temp(jpoce) )                ;  ALLOCATE( salt(jpoce) )                 
     158      ALLOCATE( zkbot(jpoce) )               ;  ALLOCATE( db(jpoce,jpksed) ) 
     159      ALLOCATE( temp(jpoce) )                ;  ALLOCATE( salt(jpoce) )   
     160      ALLOCATE( diff(jpoce,jpksed,jpwat ) )  ;  ALLOCATE( irrig(jpoce, jpksed) ) 
     161      ALLOCATE( wacc(jpoce) )                ;  ALLOCATE( fecratio(jpoce) ) 
    162162      ALLOCATE( press(jpoce) )               ;  ALLOCATE( densSW(jpoce) )  
    163       ALLOCATE( hipor(jpoce,jpksed) )        ;  ALLOCATE( co3por(jpoce,jpksed) )  
     163      ALLOCATE( hipor(jpoce,jpksed) )        ;  ALLOCATE( co3por(jpoce,jpksed) ) 
    164164      ALLOCATE( dz3d(jpoce,jpksed) )         ;  ALLOCATE( volw3d(jpoce,jpksed) )       ;  ALLOCATE( vols3d(jpoce,jpksed) ) 
     165      ALLOCATE( sedligand(jpoce, jpksed) ) 
    165166 
    166167      ! Initialization of global variables 
    167       pwcp  (:,:,:) = 0.  ;  pwcp0 (:,:,:) = 0.  ; pwcp_dta  (:,:) = 0.   
    168       solcp (:,:,:) = 0.  ;  solcp0(:,:,:) = 0.  ; rainrm_dta(:,:) = 0. 
    169       rainrm(:,:  ) = 0.  ;  rainrg(:,:  ) = 0.  ; raintg    (:  ) = 0.  
    170       dzdep (:    ) = 0.  ;  iarroce(:   ) = 0   ; dzkbot    (:  ) = 0. 
    171       temp  (:    ) = 0.  ;  salt   (:   ) = 0.   
    172       press (:    ) = 0.  ;  densSW (:   ) = 0.  
    173       hipor (:,:  ) = 0.  ;  co3por (:,: ) = 0.   
    174       dz3d  (:,:  ) = 0.  ;  volw3d (:,: ) = 0.  ;  vols3d   (:,:) = 0.  
     168      pwcp  (:,:,:) = 0.   ;  pwcp0 (:,:,:) = 0.  ; pwcp_dta  (:,:) = 0.   
     169      solcp (:,:,:) = 0.   ;  solcp0(:,:,:) = 0.  ; rainrm_dta(:,:) = 0. 
     170      rainrm(:,:  ) = 0.   ;  rainrg(:,:  ) = 0.  ; raintg    (:  ) = 0.  
     171      dzdep (:    ) = 0.   ;  iarroce(:   ) = 0   ; dzkbot    (:  ) = 0. 
     172      temp  (:    ) = 0.   ;  salt   (:   ) = 0.  ; zkbot     (:  ) = 0. 
     173      press (:    ) = 0.   ;  densSW (:   ) = 0.  ; db        (:,:) = 0.  
     174      hipor (:,:  ) = 0.   ;  co3por (:,: ) = 0.  ; irrig     (:,:) = 0.  
     175      dz3d  (:,:  ) = 0.   ;  volw3d (:,: ) = 0.  ; vols3d    (:,:) = 0.  
     176      fecratio(:)   = 1E-5  
     177      sedligand(:,:) = 0.6E-9 
    175178 
    176179      ! Chemical variables       
     
    178181      ALLOCATE( ak1ps (jpoce) )  ;  ALLOCATE( ak2ps  (jpoce) )  ;  ALLOCATE( ak3ps (jpoce) ) ;  ALLOCATE( aksis (jpoce) )     
    179182      ALLOCATE( aksps (jpoce) )  ;  ALLOCATE( ak12s  (jpoce) )  ;  ALLOCATE( ak12ps(jpoce) ) ;  ALLOCATE( ak123ps(jpoce) )     
    180       ALLOCATE( borats(jpoce) )  ;  ALLOCATE( calcon2(jpoce) )     
     183      ALLOCATE( borats(jpoce) )  ;  ALLOCATE( calcon2(jpoce) )  ;  ALLOCATE( sieqs (jpoce) )  
     184      ALLOCATE( aks3s(jpoce) )   ;  ALLOCATE( akf3s(jpoce) )    ;  ALLOCATE( sulfats(jpoce) ) 
     185      ALLOCATE( fluorids(jpoce) ) 
    181186 
    182187      akbs  (:) = 0. ;   ak1s   (:) = 0. ;  ak2s  (:) = 0. ;   akws   (:) = 0. 
    183188      ak1ps (:) = 0. ;   ak2ps  (:) = 0. ;  ak3ps (:) = 0. ;   aksis  (:) = 0. 
    184189      aksps (:) = 0. ;   ak12s  (:) = 0. ;  ak12ps(:) = 0. ;   ak123ps(:) = 0. 
    185       borats(:) = 0. ;   calcon2(:) = 0. 
     190      borats(:) = 0. ;   calcon2(:) = 0. ;  sieqs (:) = 0. 
     191      aks3s(:)  = 0. ;   akf3s(:)   = 0. ;  sulfats(:) = 0. ;  fluorids(:) = 0. 
    186192 
    187193      ! Mass balance calculation   
     
    191197      fromsed(:,:) = 0.    ;   tosed(:,:) = 0. ;  rloss(:,:) = 0.  ;   tokbot(:,:) = 0.  
    192198 
    193       ! Read sediment Namelist 
    194       !------------------------- 
    195       CALL sed_init_nam 
    196      
    197199      ! Initialization of sediment geometry 
    198200      !------------------------------------ 
    199201      CALL sed_init_geom 
    200202 
    201  
    202       ! sets initial sediment composition 
    203       ! ( only clay or reading restart file ) 
    204       !--------------------------------------- 
    205       CALL sed_init_data 
    206  
    207  
    208       CALL sed_init_wri 
    209  
     203      ! Offline specific mode 
     204      ! --------------------- 
     205      ln_sediment_offline = .FALSE. 
     206 
     207#if defined key_sed_off 
     208      ln_sediment_offline = .TRUE. 
     209      IF (lwp) write(numsed,*) 'Sediment module is run in offline mode' 
     210      IF (lwp) write(numsed,*) 'key_sed_off is activated at compilation time' 
     211      IF (lwp) write(numsed,*) 'ln_sed_2way is forced to false' 
     212      IF (lwp) write(numsed,*) '--------------------------------------------' 
     213      ln_sed_2way = .FALSE. 
     214#endif 
     215      ! Initialisation of tracer damping 
     216      ! -------------------------------- 
     217      IF (ln_sediment_offline) THEN 
     218         CALL trc_dta_ini(jptra) 
     219         CALL trc_dmp_sed_ini 
     220      ENDIF 
    210221 
    211222   END SUBROUTINE sed_init 
    212  
    213223 
    214224   SUBROUTINE sed_init_geom 
     
    227237      !! * Modules used 
    228238      !! * local declarations 
    229       INTEGER ::  & 
    230         ji, jj, jk 
    231   
    232 #if defined key_sed_off 
    233       REAL(wp) , DIMENSION (jpi,jpj) :: zdta 
    234       INTEGER  ::  numpres 
    235 #endif 
     239      INTEGER  :: ji, jj, jk, jn 
     240      REAL(wp) :: za0, za1, zt, zw, zsum, zsur, zprof, zprofw 
     241      REAL(wp) :: ztmp1, ztmp2 
    236242      !----------------------------------------------------------  
    237243 
    238       WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry ' 
    239       WRITE(numsed,*) ' ' 
     244      IF(lwp) WRITE(numsed,*) ' sed_init_geom : Initialization of sediment geometry ' 
     245      IF(lwp) WRITE(numsed,*) ' ' 
    240246 
    241247      ! Computation of 1D array of sediments points 
     
    250256      END DO 
    251257 
     258      IF ( indoce .EQ. 0 ) THEN 
     259         indoce = 1 
     260         iarroce(indoce) = 1 
     261      ENDIF 
     262 
    252263      IF( indoce .NE. jpoce ) THEN 
    253          WRITE(numsed,*) ' ' 
    254          WRITE(numsed,*) 'Warning : number of ocean points indoce = ', indoce, & 
    255             &     ' doesn''t match  number of point where epkbot>0  jpoce = ', jpoce 
    256          WRITE(numsed,*) ' ' 
    257          WRITE(numsed,*) ' ' 
    258          STOP 
     264         CALL ctl_stop( 'STOP', 'sed_ini: number of ocean points indoce doesn''t match  number of point' ) 
    259265      ELSE 
    260          WRITE(numsed,*) ' ' 
    261          WRITE(numsed,*) ' total number of ocean points jpoce =  ',jpoce 
    262          WRITE(numsed,*) ' ' 
    263       ENDIF 
    264  
    265 #if defined key_sed_off 
    266  
    267       ! Reading Netcdf Pisces file for deepest water layer thickness [m] 
    268       ! This data will be used as mask to merdge space in 1D vector 
    269       !---------------------------------------------------------------- 
    270       CALL iom_open ( 'pressbot'   , numpres ) 
    271        
    272       ! pressure  in  bars       
    273       CALL iom_get ( numpres, jpdom_data,'BATH', zdta(:,:) ) 
    274       CALL pack_arr ( jpoce, press(1:jpoce), zdta(1:jpi,1:jpj), iarroce(1:jpoce) ) 
    275       press(1:jpoce) = press(1:jpoce) * 1.025e-1  
    276  
    277       CALL iom_close ( numpres ) 
    278 #endif 
    279  
    280  
    281       ! mask sediment points for outputs 
    282       DO jk = 1, jpksed 
    283          tmasksed(:,:,jk) = tmask(:,:,1) 
    284       ENDDO 
     266         IF (lwp) WRITE(numsed,*) ' ' 
     267         IF (lwp) WRITE(numsed,*) ' total number of ocean points jpoce =  ',jpoce 
     268         IF (lwp) WRITE(numsed,*) ' ' 
     269      ENDIF 
    285270 
    286271      ! initialization of dzkbot in [cm] 
     
    288273      CALL pack_arr ( jpoce, dzkbot(1:jpoce), epkbot(1:jpi,1:jpj), iarroce(1:jpoce) ) 
    289274      dzkbot(1:jpoce) = dzkbot(1:jpoce) * 1.e+2  
     275      CALL pack_arr ( jpoce, zkbot(1:jpoce), gdepbot(1:jpi,1:jpj), iarroce(1:jpoce) ) 
    290276 
    291277      ! Geometry and  constants  
     
    293279      ! (1st layer= diffusive layer = pur water)  
    294280      !------------------------------------------ 
    295       dz(1)  = 0.1 
    296       dz(2)  = 0.3 
    297       dz(3)  = 0.3 
    298       dz(4)  = 0.5 
    299       dz(5)  = 0.5 
    300       dz(6)  = 0.5 
    301       dz(7)  = 1. 
    302       dz(8)  = 1. 
    303       dz(9)  = 1. 
    304       dz(10) = 2.45 
    305       dz(11) = 2.45 
     281      za1  = (  sedzmin - sedhmax / FLOAT(jpksed-1)  )                                                      & 
     282         & / ( TANH((1-sedkth)/sedacr) - sedacr/FLOAT(jpksed-1) * (  LOG( COSH( (jpksed - sedkth) / sedacr) )      & 
     283         &                                                   - LOG( COSH( ( 1  - sedkth) / sedacr) )  )  ) 
     284      za0  = sedzmin - za1 * TANH( (1-sedkth) / sedacr ) 
     285      zsur = - za0 - za1 * sedacr * LOG( COSH( (1-sedkth) / sedacr )  ) 
     286 
     287      profsedw(1) = 0.0 
     288      profsed(1) = -dz(1) / 2. 
     289      DO jk = 2, jpksed 
     290         zw = REAL( jk , wp ) 
     291         zt = REAL( jk , wp ) - 0.5_wp 
     292         profsed(jk)  = ( zsur + za0 * zt + za1 * sedacr * LOG ( COSH( (zt-sedkth) / sedacr ) )  )  
     293         profsedw(jk) = ( zsur + za0 * zw + za1 * sedacr * LOG ( COSH( (zw-sedkth) / sedacr ) )  ) 
     294      END DO 
     295 
     296      dz(1) = 0.1 
     297      DO jk = 2, jpksed 
     298         dz(jk) = profsedw(jk) - profsedw(jk-1) 
     299      END DO 
    306300 
    307301      DO jk = 1, jpksed 
     
    311305      ENDDO 
    312306 
    313       ! Depth(jk)= depth of middle of each layer 
    314       !---------------------------------------- 
    315       profsed(1) = -dz(1)/ 2. 
    316       DO jk = 2, jpksed 
    317          profsed(jk) = profsed(jk-1) + dz(jk-1) / 2. + dz(jk) / 2. 
    318       ENDDO 
    319  
    320307      !  Porosity profile [0] 
    321308      !--------------------- 
    322       por(1)  = 1. 
    323       por(2)  = 0.95 
    324       por(3)  = 0.9 
    325       por(4)  = 0.85 
    326       por(5)  = 0.81 
    327       por(6)  = 0.75 
    328       por(7)  = 0.75       
    329       por(8)  = 0.75       
    330       por(9)  = 0.75       
    331       por(10) = 0.75 
    332       por(11) = 0.75 
     309      por(1) = 1.0 
     310      DO jk = 2, jpksed 
     311         por(jk) = porinf + ( porsurf-porinf) * exp(-rhox * (profsed(jk) ) ) 
     312      END DO 
    333313  
    334314      ! inverse of  Porosity profile 
     
    353333      dz3d(1:jpoce,1) = dz(1) 
    354334 
    355  
    356335      !--------------------------------------------- 
    357336      ! Molecular weight [g/mol] for solid species 
    358337      !--------------------------------------------- 
    359  
    360338 
    361339      ! opal=sio2*0.4(h20)=28+2*16+0.4*(2+16) 
     
    371349         &              0.59 * 27. + 10. * 16. 
    372350 
     351      mol_wgt(jsfeo)  = 55.0 + 3.0 * ( 16.0 + 1.0) 
     352 
     353      mol_wgt(jsfes)  = 55.0 + 32.0 
     354 
    373355      ! for chemistry Poc : C(122)H(244)O(86)N(16)P(1) 
    374356      ! But den sity of Poc is an Hydrated material (= POC + 30H2O) 
     
    377359      mol_wgt(jspoc) = ( 122. * 12. + 355. + 120. * 16.+ & 
    378360         &                16. * 14. + 31. ) / 122. 
     361      mol_wgt(jspos) = mol_wgt(jspoc) 
     362      mol_wgt(jspor) = mol_wgt(jspoc) 
    379363 
    380364      ! CaCO3 
     
    384368      ! Density of solid material in sediment [g/cm**3] 
    385369      !------------------------------------------------ 
    386       dens = 2.6 
     370      denssol = 2.6 
    387371 
    388372      ! Initialization of diffusion coefficient as function of porosity [cm**2/s] 
    389373      !-------------------------------------------------------------------- 
    390       diff(:) = dcoef * por(:) 
     374!      DO jn = 1, jpsol 
     375!         DO jk = 1, jpksed 
     376!            DO ji = 1, jpoce 
     377!               diff(ji,jk,jn) = dcoef / ( 1.0 - 2.0 * log(por(jk)) ) 
     378!            END DO 
     379!         END DO 
     380!      END DO 
     381 
     382      ! Accumulation rate from Burwicz et al. (2011). This is used to 
     383      ! compute the flux of clays and minerals 
     384      ! -------------------------------------------------------------- 
     385      DO ji = 1, jpoce 
     386          ztmp1 = 0.117 / ( 1.0 + ( zkbot(ji) / 200.)**3 ) 
     387          ztmp2 = 0.006 / ( 1.0 + ( zkbot(ji) / 4000.)**10 ) 
     388          wacc(ji) = ztmp1 + ztmp2 
     389      END DO 
    391390 
    392391 
    393392      ! Initialization of time step as function of porosity [cm**2/s] 
    394393      !------------------------------------------------------------------ 
    395       rdtsed(2:jpksed) = dtsed / ( dens * por1(2:jpksed) ) 
    396       
    397394   END SUBROUTINE sed_init_geom 
    398395 
     
    408405      !!---------------------------------------------------------------------- 
    409406 
    410       INTEGER :: & 
    411          numnamsed = 28 
     407      INTEGER ::   numnamsed_ref = -1           !! Logical units for namelist sediment 
     408      INTEGER ::   numnamsed_cfg = -1           !! Logical units for namelist sediment 
     409      INTEGER :: ios                 ! Local integer output status for namelist read 
     410      CHARACTER(LEN=20)   ::   clname 
    412411 
    413412      TYPE PSED 
     
    422421      TYPE(PSED) , DIMENSION(jpdia2dsed) :: seddiag2d 
    423422 
    424       NAMELIST/nam_time/nfreq 
     423      NAMELIST/nam_run/nrseddt,ln_sed_2way 
     424      NAMELIST/nam_geom/jpksed, sedzmin, sedhmax, sedkth, sedacr, porsurf, porinf, rhox 
    425425      NAMELIST/nam_trased/sedsol, sedwat 
    426426      NAMELIST/nam_diased/seddiag3d, seddiag2d 
    427       NAMELIST/nam_reac/sisat, claysat, rcopal, rcclay, dcoef  
    428       NAMELIST/nam_poc/redO2, redNo3, redPo4, redC, redDnit, & 
    429          &           rcorg, o2seuil, rcorgN 
    430       NAMELIST/nam_cal/rccal 
    431       NAMELIST/nam_dc13/pdb, rc13P, rc13Ca 
    432       NAMELIST/nam_btb/dbiot 
    433       NAMELIST/nam_rst/ln_rst_sed 
    434  
    435       INTEGER :: jn, jn1 
     427      NAMELIST/nam_inorg/rcopal, dcoef, rccal, ratligc, rcligc 
     428      NAMELIST/nam_poc/redO2, redNo3, redPo4, redC, redfep, rcorgl, rcorgs,  & 
     429         &             rcorgr, rcnh4, rch2s, rcfe2, rcfeh2s, rcfes, rcfeso,  & 
     430         &             xksedo2, xksedno3, xksedfeo, xksedso4 
     431      NAMELIST/nam_btb/dbiot, ln_btbz, dbtbzsc, adsnh4, ln_irrig, xirrzsc 
     432      NAMELIST/nam_rst/ln_rst_sed, cn_sedrst_indir, cn_sedrst_outdir, cn_sedrst_in, cn_sedrst_out 
     433 
     434      INTEGER :: ji, jn, jn1 
    436435      !------------------------------------------------------- 
    437436 
    438       WRITE(numsed,*) ' sed_init_nam : Read namelists ' 
    439       WRITE(numsed,*) ' ' 
     437      IF(lwp) WRITE(numsed,*) ' sed_init_nam : Read namelists ' 
     438      IF(lwp) WRITE(numsed,*) ' ' 
    440439 
    441440      ! ryear = 1 year converted in second 
    442441      !------------------------------------ 
    443       WRITE(numsed,*) ' ' 
    444       WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear 
    445       WRITE(numsed,*) ' '      
     442      IF (lwp) THEN 
     443         WRITE(numsed,*) ' ' 
     444         WRITE(numsed,*) 'number of seconds in one year : ryear = ', ryear 
     445         WRITE(numsed,*) ' '      
     446      ENDIF 
    446447 
    447448      ! Reading namelist.sed variables 
    448449      !--------------------------------- 
    449       CALL ctl_opn( numnamsed, 'namelist.sediment', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    450  
    451       dtsed = rdt 
     450      clname = 'namelist_sediment' 
     451      IF(lwp) WRITE(numsed,*) ' sed_init_nam : read SEDIMENT namelist' 
     452      IF(lwp) WRITE(numsed,*) ' ~~~~~~~~~~~~~~' 
     453      CALL ctl_opn( numnamsed_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     454      CALL ctl_opn( numnamsed_cfg, TRIM( clname )//'_cfg', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     455 
    452456      nitsed000 = nittrc000 
    453457      nitsedend = nitend 
    454 #if ! defined key_sed_off 
    455       nwrised   = nwritetrc 
    456 #else 
    457       nwrised   = nwrite 
    458 #endif 
    459      ! Diffraction/reaction parameters 
    460       !---------------------------------- 
    461       READ( numnamsed, nam_time ) 
    462       WRITE(numsed,*) ' namelist nam_time' 
    463  
    464 #if ! defined key_sed_off 
    465       nfreq     = 1 
    466 #endif 
    467  
    468       WRITE(numsed,*) ' sedimentation time step              dtsed      = ', dtsed 
    469       WRITE(numsed,*) ' 1st time step for sediment.          nitsed000  = ', nitsed000 
    470       WRITE(numsed,*) ' last time step for sediment.         nitsedend  = ', nitsedend 
    471       WRITE(numsed,*) ' frequency of sediment outputs        nwrised    = ', nwrised 
    472       WRITE(numsed,*) ' frequency of restoring inputs data   nfreq      = ', nfreq 
    473       WRITE(numsed,*) ' ' 
    474  
    475       REWIND( numnamsed )               ! read nattrc 
    476       READ  ( numnamsed, nam_trased ) 
     458      ! Namelist nam_run 
     459      REWIND( numnamsed_ref )              ! Namelist nam_run in reference namelist : Pisces variables 
     460      READ  ( numnamsed_ref, nam_run, IOSTAT = ios, ERR = 901) 
     461901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in reference namelist', lwp ) 
     462 
     463      REWIND( numnamsed_cfg )              ! Namelist nam_run in reference namelist : Pisces variables 
     464      READ  ( numnamsed_cfg, nam_run, IOSTAT = ios, ERR = 902) 
     465902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_run in configuration namelist', lwp ) 
     466 
     467      IF (lwp) THEN 
     468         WRITE(numsed,*) ' namelist nam_run' 
     469         WRITE(numsed,*) ' Nb of iterations for fast species    nrseddt = ', nrseddt 
     470         WRITE(numsed,*) ' 2-way coupling between PISCES and Sed ln_sed_2way = ', ln_sed_2way 
     471      ENDIF 
     472 
     473      REWIND( numnamsed_ref )              ! Namelist nam_geom in reference namelist : Pisces variables 
     474      READ  ( numnamsed_ref, nam_geom, IOSTAT = ios, ERR = 903) 
     475903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in reference namelist', lwp ) 
     476 
     477      REWIND( numnamsed_cfg )              ! Namelist nam_geom in reference namelist : Pisces variables 
     478      READ  ( numnamsed_cfg, nam_geom, IOSTAT = ios, ERR = 904) 
     479904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_geom in configuration namelist', lwp ) 
     480 
     481      IF (lwp) THEN  
     482         WRITE(numsed,*) ' namelist nam_geom' 
     483         WRITE(numsed,*) ' Number of vertical layers            jpksed  = ', jpksed 
     484         WRITE(numsed,*) ' Minimum vertical spacing             sedzmin = ', sedzmin 
     485         WRITE(numsed,*) ' Maximum depth of the sediment        sedhmax = ', sedhmax 
     486         WRITE(numsed,*) ' Default parameter                    sedkth  = ', sedkth 
     487         WRITE(numsed,*) ' Default parameter                    sedacr  = ', sedacr 
     488         WRITE(numsed,*) ' Sediment porosity at the surface     porsurf = ', porsurf 
     489         WRITE(numsed,*) ' Sediment porosity at infinite depth  porinf  = ', porinf 
     490         WRITE(numsed,*) ' Length scale of porosity variation   rhox    = ', rhox 
     491      ENDIF 
     492 
     493      jpksedm1  = jpksed - 1 
     494      dtsed = r2dttrc 
     495 
     496      REWIND( numnamsed_ref )              ! Namelist nam_trased in reference namelist : Pisces variables 
     497      READ  ( numnamsed_ref, nam_trased, IOSTAT = ios, ERR = 905) 
     498905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in reference namelist', lwp ) 
     499 
     500      REWIND( numnamsed_cfg )              ! Namelist nam_trased in reference namelist : Pisces variables 
     501      READ  ( numnamsed_cfg, nam_trased, IOSTAT = ios, ERR = 906) 
     502906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_trased in configuration namelist', lwp ) 
    477503 
    478504      DO jn = 1, jpsol 
     
    489515      END DO 
    490516 
    491       WRITE(numsed,*) ' namelist nam_trased' 
    492       WRITE(numsed,*) ' ' 
    493       DO jn = 1, jptrased 
    494          WRITE(numsed,*) 'name of 3d output sediment field number :',jn,' : ',TRIM(sedtrcd(jn)) 
    495          WRITE(numsed,*) 'long name ', TRIM(sedtrcl(jn)) 
    496          WRITE(numsed,*) ' in unit = ', TRIM(sedtrcu(jn)) 
    497          WRITE(numsed,*) ' ' 
    498       END DO 
    499       WRITE(numsed,*) ' ' 
    500  
     517      IF (lwp) THEN 
     518         WRITE(numsed,*) ' namelist nam_trased' 
     519         WRITE(numsed,*) ' ' 
     520         DO jn = 1, jptrased 
     521            WRITE(numsed,*) 'name of 3d output sediment field number :',jn,' : ',TRIM(sedtrcd(jn)) 
     522            WRITE(numsed,*) 'long name ', TRIM(sedtrcl(jn)) 
     523            WRITE(numsed,*) ' in unit = ', TRIM(sedtrcu(jn)) 
     524            WRITE(numsed,*) ' ' 
     525         END DO 
     526         WRITE(numsed,*) ' ' 
     527      ENDIF 
     528 
     529      REWIND( numnamsed_ref )              ! Namelist nam_diased in reference namelist : Pisces variables 
     530      READ  ( numnamsed_ref, nam_diased, IOSTAT = ios, ERR = 907) 
     531907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in reference namelist', lwp ) 
     532 
     533      REWIND( numnamsed_cfg )              ! Namelist nam_diased in reference namelist : Pisces variables 
     534      READ  ( numnamsed_cfg, nam_diased, IOSTAT = ios, ERR = 908) 
     535908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diased in configuration namelist', lwp ) 
    501536       
    502       REWIND( numnamsed ) 
    503       READ( numnamsed, nam_diased ) 
    504  
    505537      DO jn = 1, jpdia3dsed 
    506538         seddia3d(jn) = seddiag3d(jn)%snamesed 
     
    515547      END DO 
    516548 
    517       WRITE(numsed,*) ' namelist nam_diased' 
    518       WRITE(numsed,*) ' ' 
    519       DO jn = 1, jpdia3dsed 
    520          WRITE(numsed,*) 'name of 3D output diag number :',jn, ' : ', TRIM(seddia3d(jn)) 
    521          WRITE(numsed,*) 'long name ', TRIM(seddia3l(jn)) 
    522          WRITE(numsed,*) ' in unit = ',TRIM(seddia3u(jn)) 
    523          WRITE(numsed,*) ' ' 
    524       END DO 
    525  
    526       DO jn = 1, jpdia2dsed 
    527          WRITE(numsed,*) 'name of 2D output diag number :',jn, ' : ', TRIM(seddia2d(jn)) 
    528          WRITE(numsed,*) 'long name ', TRIM(seddia2l(jn)) 
    529          WRITE(numsed,*) ' in unit = ',TRIM(seddia2u(jn)) 
    530          WRITE(numsed,*) ' ' 
    531       END DO 
    532  
    533       WRITE(numsed,*) ' ' 
    534  
    535  
    536       ! Diffraction/reaction parameters 
     549      IF (lwp) THEN 
     550         WRITE(numsed,*) ' namelist nam_diased' 
     551         WRITE(numsed,*) ' ' 
     552         DO jn = 1, jpdia3dsed 
     553            WRITE(numsed,*) 'name of 3D output diag number :',jn, ' : ', TRIM(seddia3d(jn)) 
     554            WRITE(numsed,*) 'long name ', TRIM(seddia3l(jn)) 
     555            WRITE(numsed,*) ' in unit = ',TRIM(seddia3u(jn)) 
     556            WRITE(numsed,*) ' ' 
     557         END DO 
     558 
     559         DO jn = 1, jpdia2dsed 
     560            WRITE(numsed,*) 'name of 2D output diag number :',jn, ' : ', TRIM(seddia2d(jn)) 
     561            WRITE(numsed,*) 'long name ', TRIM(seddia2l(jn)) 
     562            WRITE(numsed,*) ' in unit = ',TRIM(seddia2u(jn)) 
     563            WRITE(numsed,*) ' ' 
     564         END DO 
     565 
     566         WRITE(numsed,*) ' ' 
     567      ENDIF 
     568 
     569      ! Inorganic chemistry parameters 
    537570      !---------------------------------- 
    538       REWIND( numnamsed ) 
    539       READ( numnamsed, nam_reac ) 
    540       WRITE(numsed,*) ' namelist nam_reac' 
    541       WRITE(numsed,*) ' saturation for si    sisat   = ', sisat 
    542       WRITE(numsed,*) ' saturation for clay  claysat = ', claysat 
    543       WRITE(numsed,*) ' reactivity for Si    rcopal  = ', rcopal 
    544       WRITE(numsed,*) ' reactivity for clay  rcclay  = ', rcclay 
    545       WRITE(numsed,*) ' diff. coef for por.  dcoef   = ', dcoef 
    546       WRITE(numsed,*) ' ' 
    547  
     571      REWIND( numnamsed_ref )              ! Namelist nam_inorg in reference namelist : Pisces variables 
     572      READ  ( numnamsed_ref, nam_inorg, IOSTAT = ios, ERR = 909) 
     573909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in reference namelist', lwp ) 
     574 
     575      REWIND( numnamsed_cfg )              ! Namelist nam_inorg in reference namelist : Pisces variables 
     576      READ  ( numnamsed_cfg, nam_inorg, IOSTAT = ios, ERR = 910) 
     577910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_inorg in configuration namelist', lwp ) 
     578 
     579      IF (lwp) THEN 
     580         WRITE(numsed,*) ' namelist nam_inorg' 
     581         WRITE(numsed,*) ' reactivity for Si      rcopal  = ', rcopal 
     582         WRITE(numsed,*) ' diff. coef for por.    dcoef   = ', dcoef 
     583         WRITE(numsed,*) ' reactivity for calcite rccal   = ', rccal 
     584         WRITE(numsed,*) ' L/C ratio in POC       ratligc = ', ratligc 
     585         WRITE(numsed,*) ' reactivity for ligands rcligc  = ', rcligc 
     586         WRITE(numsed,*) ' ' 
     587      ENDIF 
    548588 
    549589      ! Unity conversion to get saturation conc. psat in [mol.l-1] 
    550590      ! and reactivity rc in  [l.mol-1.s-1] 
    551591      !---------------------------------------------------------- 
    552       sat_sil   = sisat   * 1.e-6    
    553       sat_clay  = claysat * 1.e-6 
    554  
    555       reac_sil  = rcopal / ryear      
    556       reac_clay  = rcclay / ryear 
    557  
     592      reac_sil   = rcopal / ryear      
     593      reac_ligc  = rcligc / ryear 
    558594 
    559595      ! Additional parameter linked to POC/O2/No3/Po4 
    560596      !---------------------------------------------- 
    561       REWIND( numnamsed ) 
    562       READ( numnamsed, nam_poc ) 
    563       WRITE(numsed,*) ' namelist nam_poc' 
    564       WRITE(numsed,*) ' Redfield coef for oxy     redO2   = ', redO2 
    565       WRITE(numsed,*) ' Redfield coef for no3     redNo3  = ', redNo3 
    566       WRITE(numsed,*) ' Redfield coef for po4     redPo4  = ', redPo4 
    567       WRITE(numsed,*) ' Redfield coef for carbone redC    = ', redC 
    568       WRITE(numsed,*) ' Redfield coef for denitri redDnit = ', redDnit 
    569       WRITE(numsed,*) ' reactivity for POC/O2     rcorg   = ', rcorg 
    570       WRITE(numsed,*) ' threshold O2 concen.      o2seuil = ', o2seuil 
    571       WRITE(numsed,*) ' reactivity for POC/NO3    rcorgN  = ', rcorgN 
    572       WRITE(numsed,*) ' ' 
    573  
    574  
    575       so2ut  = redO2   / redC 
    576       srno3  = redNo3  / redC 
    577       spo4r  = redPo4  / redC 
    578       srDnit = redDnit / redC 
    579       sthro2 = o2seuil * 1.e-6 ! threshold O2 concen. in [mol.l-1] 
     597      REWIND( numnamsed_ref )              ! Namelist nam_poc in reference namelist : Pisces variables 
     598      READ  ( numnamsed_ref, nam_poc, IOSTAT = ios, ERR = 911) 
     599911   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in reference namelist', lwp ) 
     600 
     601      REWIND( numnamsed_cfg )              ! Namelist nam_poc in reference namelist : Pisces variables 
     602      READ  ( numnamsed_cfg, nam_poc, IOSTAT = ios, ERR = 912) 
     603912   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_poc in configuration namelist', lwp ) 
     604 
     605      IF (lwp) THEN 
     606         WRITE(numsed,*) ' namelist nam_poc' 
     607         WRITE(numsed,*) ' Redfield coef for oxy            redO2    = ', redO2 
     608         WRITE(numsed,*) ' Redfield coef for no3            redNo3   = ', redNo3 
     609         WRITE(numsed,*) ' Redfield coef for po4            redPo4   = ', redPo4 
     610         WRITE(numsed,*) ' Redfield coef for carbon         redC     = ', redC 
     611         WRITE(numsed,*) ' Ration for iron bound P          redfep   = ', redfep 
     612         WRITE(numsed,*) ' reactivity for labile POC        rcorgl   = ', rcorgl 
     613         WRITE(numsed,*) ' reactivity for semi-refract. POC rcorgs   = ', rcorgs 
     614         WRITE(numsed,*) ' reactivity for refractory POC    rcorgr   = ', rcorgr 
     615         WRITE(numsed,*) ' reactivity for NH4               rcnh4    = ', rcnh4 
     616         WRITE(numsed,*) ' reactivity for H2S               rch2s    = ', rch2s 
     617         WRITE(numsed,*) ' reactivity for Fe2+              rcfe2    = ', rcfe2 
     618         WRITE(numsed,*) ' reactivity for FeOH/H2S          rcfeh2s  = ', rcfeh2s 
     619         WRITE(numsed,*) ' reactivity for Fe2+/H2S          rcfes    = ', rcfes 
     620         WRITE(numsed,*) ' reactivity for FeS/O2            rcfeso   = ', rcfeso 
     621         WRITE(numsed,*) ' Half-sat. cste for oxic remin    xksedo2  = ', xksedo2 
     622         WRITE(numsed,*) ' Half-sat. cste for denit.        xksedno3 = ', xksedno3 
     623         WRITE(numsed,*) ' Half-sat. cste for iron remin    xksedfeo = ', xksedfeo 
     624         WRITE(numsed,*) ' Half-sat. cste for SO4 remin     xksedso4 = ', xksedso4 
     625         WRITE(numsed,*) ' ' 
     626      ENDIF 
     627 
     628 
     629      so2ut  = redO2    / redC 
     630      srno3  = redNo3   / redC 
     631      spo4r  = redPo4   / redC 
     632      srDnit = ( (redO2 + 32. ) * 0.8 - redNo3 - redNo3 * 0.6 ) / redC 
    580633      ! reactivity rc in  [l.mol-1.s-1] 
    581       reac_poc  = rcorg / ryear 
    582       reac_no3 = rcorgN  / ryear 
    583  
    584  
    585       ! Carbonate parameters 
    586       !--------------------- 
    587       READ( numnamsed, nam_cal ) 
    588       WRITE(numsed,*) ' namelist  nam_cal' 
    589       WRITE(numsed,*) ' reactivity for calcite rccal = ', rccal 
    590       WRITE(numsed,*) ' ' 
     634      reac_pocl  = rcorgl / ryear 
     635      reac_pocs  = rcorgs / ryear 
     636      reac_pocr  = rcorgr / ryear 
     637      reac_nh4   = rcnh4  / ryear 
     638      reac_h2s   = rch2s  / ryear 
     639      reac_fe2   = rcfe2  / ryear 
     640      reac_feh2s = rcfeh2s/ ryear 
     641      reac_fes   = rcfes  / ryear 
     642      reac_feso  = rcfeso / ryear 
    591643 
    592644      ! reactivity rc in  [l.mol-1.s-1]       
    593645      reac_cal = rccal / ryear 
    594646 
    595  
    596       ! C13  parameters 
    597       !---------------- 
    598       READ( numnamsed, nam_dc13 ) 
    599       WRITE(numsed,*) ' namelist nam_dc13 '  
    600       WRITE(numsed,*) ' 13C/12C in PD Belemnite        PDB    = ', pdb 
    601       WRITE(numsed,*) ' 13C/12C in POC = rc13P*PDB     rc13P  = ', rc13P 
    602       WRITE(numsed,*) ' 13C/12C in CaCO3 = rc13Ca*PDB  rc13Ca = ', rc13Ca 
    603       WRITE(numsed,*) ' ' 
    604  
    605        
    606647      ! Bioturbation parameter 
    607648      !------------------------ 
    608       READ( numnamsed, nam_btb ) 
    609       WRITE(numsed,*) ' namelist nam_btb '  
    610       WRITE(numsed,*) ' coefficient for bioturbation   dbiot    = ', dbiot 
    611       WRITE(numsed,*) ' ' 
    612  
    613       ! Unity convertion to get bioturb coefficient in [cm2.s-1] 
    614       db = dbiot / ( ryear * 1000. ) 
     649      REWIND( numnamsed_ref )              ! Namelist nam_btb in reference namelist : Pisces variables 
     650      READ  ( numnamsed_ref, nam_btb, IOSTAT = ios, ERR = 913) 
     651913   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in reference namelist', lwp ) 
     652 
     653      REWIND( numnamsed_cfg )              ! Namelist nam_btb in reference namelist : Pisces variables 
     654      READ  ( numnamsed_cfg, nam_btb, IOSTAT = ios, ERR = 914) 
     655914   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_btb in configuration namelist', lwp ) 
     656 
     657      IF (lwp) THEN 
     658         WRITE(numsed,*) ' namelist nam_btb '  
     659         WRITE(numsed,*) ' coefficient for bioturbation      dbiot    = ', dbiot 
     660         WRITE(numsed,*) ' Depth varying bioturbation        ln_btbz  = ', ln_btbz 
     661         WRITE(numsed,*) ' coefficient for btb attenuation   dbtbzsc  = ', dbtbzsc 
     662         WRITE(numsed,*) ' Adsorption coefficient of NH4     adsnh4   = ', adsnh4 
     663         WRITE(numsed,*) ' Bioirrigation in sediment         ln_irrig = ', ln_irrig 
     664         WRITE(numsed,*) ' coefficient for irrig attenuation xirrzsc  = ', xirrzsc 
     665         WRITE(numsed,*) ' ' 
     666      ENDIF 
    615667 
    616668      ! Initial value (t=0) for sediment pore water and solid components 
    617669      !---------------------------------------------------------------- 
    618       READ( numnamsed, nam_rst ) 
    619       WRITE(numsed,*) ' namelist  nam_rst '  
    620       WRITE(numsed,*) '  boolean term for restart (T or F) ln_rst_sed = ', ln_rst_sed  
    621       WRITE(numsed,*) ' ' 
    622  
    623       CLOSE( numnamsed ) 
     670      REWIND( numnamsed_ref )              ! Namelist nam_rst in reference namelist : Pisces variables 
     671      READ  ( numnamsed_ref, nam_rst, IOSTAT = ios, ERR = 915) 
     672915   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in reference namelist', lwp ) 
     673 
     674      REWIND( numnamsed_cfg )              ! Namelist nam_rst in reference namelist : Pisces variables 
     675      READ  ( numnamsed_cfg, nam_rst, IOSTAT = ios, ERR = 916) 
     676916   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_rst in configuration namelist', lwp ) 
     677 
     678      IF (lwp) THEN 
     679         WRITE(numsed,*) ' namelist  nam_rst '  
     680         WRITE(numsed,*) '  boolean term for restart (T or F) ln_rst_sed = ', ln_rst_sed  
     681         WRITE(numsed,*) ' ' 
     682      ENDIF 
     683      nn_dtsed = nn_dttrc 
     684 
     685      CLOSE( numnamsed_cfg ) 
     686      CLOSE( numnamsed_ref ) 
    624687 
    625688   END SUBROUTINE sed_init_nam 
    626689 
    627    SUBROUTINE sed_init_data 
    628       !!---------------------------------------------------------------------- 
    629       !!                   ***  ROUTINE sed_init_data  *** 
    630       !! 
    631       !! ** Purpose :  Initialization of sediment module 
    632       !!               - sets initial sediment composition 
    633       !!                 ( only clay or reading restart file ) 
    634       !! 
    635       !!   History : 
    636       !!        !  06-07  (C. Ethe)  original 
    637       !!---------------------------------------------------------------------- 
    638   
    639       ! local variables 
    640       INTEGER :: & 
    641          ji, jk, zhipor 
    642  
    643       !-------------------------------------------------------------------- 
    644   
    645  
    646       IF( .NOT. ln_rst_sed ) THEN 
    647  
    648           WRITE(numsed,*) ' Initilization of default values of sediment components' 
    649  
    650          ! default values for initial pore water concentrations [mol/l] 
    651          pwcp(:,:,:) = 0. 
    652          ! default value for initial solid component (fraction of dry weight dim=[0]) 
    653          ! clay 
    654          solcp(:,:,:) = 0. 
    655          solcp(:,2:jpksed,jsclay) = 1. 
    656  
    657          ! Initialization of [h+] and [co3--] 
    658  
    659          zhipor = 8. 
    660          ! Initialization of [h+] in mol/kg 
    661          DO jk = 1, jpksed 
    662             DO ji = 1, jpoce 
    663                hipor (ji,jk) = 10.**( -1. * zhipor ) 
    664             ENDDO 
    665          ENDDO 
    666  
    667          co3por(:,:) = 0. 
    668  
    669       ELSE    
    670    
    671          WRITE(numsed,*) ' Initilization of Sediment components from restart' 
    672  
    673          CALL sed_rst_read 
    674  
    675       ENDIF 
    676  
    677  
    678       ! Load initial Pisces Data for bot. wat. Chem and fluxes 
    679       CALL sed_dta ( nitsed000 )  
    680  
    681       ! Initialization of chemical constants 
    682       CALL sed_chem ( nitsed000 ) 
    683  
    684       ! Stores initial sediment data for mass balance calculation 
    685       pwcp0 (1:jpoce,1:jpksed,1:jpwat ) = pwcp (1:jpoce,1:jpksed,1:jpwat )  
    686       solcp0(1:jpoce,1:jpksed,1:jpsol ) = solcp(1:jpoce,1:jpksed,1:jpsol)  
    687  
    688       ! Conversion of [h+] in mol/Kg to get it in mol/l ( multiplication by density) 
    689       DO jk = 1, jpksed 
    690          hipor(1:jpoce,jk) = hipor(1:jpoce,jk) * densSW(1:jpoce) 
    691       ENDDO 
    692  
    693  
    694       ! In default case - no restart - sedco3 is run to initiate [h+] and [co32-] 
    695       ! Otherwise initiate values of pH and co3 read in restart 
    696       IF( .NOT. ln_rst_sed ) THEN 
    697          ! sedco3 is run to initiate[h+] [co32-] in mol/l of solution 
    698          CALL sed_co3 ( nitsed000 ) 
    699  
    700       ENDIF 
    701              
    702    END SUBROUTINE sed_init_data 
    703  
    704    SUBROUTINE sed_init_wri 
    705  
    706       INTEGER :: jk 
    707  
    708       WRITE(numsed,*)' ' 
    709       WRITE(numsed,*)'======== Write summary of initial state   ============' 
    710       WRITE(numsed,*)' ' 
    711       WRITE(numsed,*)' ' 
    712       WRITE(numsed,*)'-------------------------------------------------------------------' 
    713       WRITE(numsed,*)' Initial Conditions ' 
    714       WRITE(numsed,*)'-------------------------------------------------------------------' 
    715       WRITE(numsed,*)'dzm = dzkbot minimum to calculate ', 0. 
    716       WRITE(numsed,*)'Local zone : jpi, jpj : ',jpi, jpj 
    717       WRITE(numsed,*)'jpoce = ',jpoce,' nbtot pts = ',jpij,' nb earth pts = ',jpij - jpoce 
    718       WRITE(numsed,*)'sublayer thickness dz(1) [cm] : ', dz(1) 
    719       WRITE(numsed,*)'Coeff diff for k=1 (cm2/s) : ',diff(1) 
    720       WRITE(numsed,*)' nb solid comp : ',jpsol 
    721       WRITE(numsed,*)'(1=opal,2=clay,3=POC,4=CaCO3)' 
    722       WRITE(numsed,*)'weight mol 1,2,3,4' 
    723       WRITE(numsed,'(4(F0.2,3X))')mol_wgt(jsopal),mol_wgt(jsclay),mol_wgt(jspoc),mol_wgt(jscal) 
    724       WRITE(numsed,*)'nb dissolved comp',jpwat 
    725       WRITE(numsed,*)'(1=silicic acid,2="dissolved" clay,3=O2,4=DIC,5=Nitrate,& 
    726          &6=Phosphates,7=Alk))' 
    727       WRITE(numsed,*)'Psat (umol/l) for silicic Acid and "dissolved" clay' 
    728       WRITE(numsed,'(2(F0.2,3X))') sat_sil * 1e+6,  sat_clay * 1e+6 
    729       WRITE(numsed,*)'reaction rate rc for Op/si,Clay,POC/O2,caco3, POC/No3 (an-1)' 
    730       WRITE(numsed,'(5(F0.2,3X))') reac_sil * ryear, reac_clay * ryear, reac_poc * ryear, & 
    731                                    reac_cal * ryear, reac_no3 * ryear 
    732       WRITE(numsed,*)'redfield coef C,O,N P Dit ' 
    733       WRITE(numsed,'(5(F0.2,3X))')1./spo4r,so2ut/spo4r,srno3/spo4r,spo4r/spo4r,srDnit/spo4r 
    734       WRITE(numsed,*)'threshold for stating denitrification [mol/l]' 
    735       WRITE(numsed,'(1PE8.2)') sthrO2 
    736       WRITE(numsed,*)'-------------------------------------------------------------------' 
    737       WRITE(numsed,*)'Min-Max-Mean' 
    738       WRITE(numsed,*)'For each variable : min, max, moy value observed on selected local zone' 
    739       WRITE(numsed,*)'-------------------------------------------------------------------' 
    740       WRITE(numsed,*)'thickness of the last wet layer dzkbot [m]' 
    741       WRITE(numsed,'(3(F0.2,3X))') MINVAL(dzkbot(1:jpoce))/100.,MAXVAL(dzkbot(1:jpoce))/100.,& 
    742          &SUM(dzkbot(1:jpoce))/jpoce/100. 
    743       WRITE(numsed,*)'temp [°C]' 
    744       WRITE(numsed,'(3(F0.2,3X))') MINVAL(temp(1:jpoce)),MAXVAL(temp(1:jpoce)),& 
    745          &                         SUM(temp(1:jpoce))/jpoce 
    746       WRITE(numsed,*)'salt o/oo' 
    747       WRITE(numsed,'(3(F0.2,3X))')MINVAL(salt(1:jpoce)),MAXVAL(salt(1:jpoce)),& 
    748          &                        SUM(salt(1:jpoce))/jpoce 
    749 #if defined key_sed_off 
    750       WRITE(numsed,*)'pressure [bar] (depth in m is about 10*pressure)' 
    751       WRITE(numsed,'(3(F0.2,3X))') MINVAL(press(1:jpoce)),MAXVAL(press(1:jpoce)),& 
    752          &                         SUM(press(1:jpoce))/jpoce 
    753 #endif 
    754       WRITE(numsed,*)'density of Sea Water' 
    755       WRITE(numsed,'(3(F0.2,3X))') MINVAL(densSW(1:jpoce)), MAXVAL(densSW(1:jpoce)),& 
    756          &                         SUM(densSW(1:jpoce))/jpoce 
    757       WRITE(numsed,*)'' 
    758       WRITE(numsed,*)'     Dissolved Components ' 
    759       WRITE(numsed,*)'     =====================' 
    760       WRITE(numsed,*)'[Si(OH)4] dissolved (1)(k=1)(µmol/l)(and min value in mol/kg  of solution)' 
    761       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwsil))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwsil))*1.e+6,& 
    762          &                         SUM(pwcp(1:jpoce,1,jwsil))*1.e+6/jpoce,& 
    763          &                         MINVAL(pwcp(1:jpoce,1,jwsil)*1.e+6/densSW(1:jpoce)) 
    764       WRITE(numsed,*)'[O2]    dissolved (3) (k=1)(µmol/l)(and min value in mol/kg  of solution)' 
    765       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwoxy))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwoxy))*1.e+6,& 
    766          &SUM(pwcp(1:jpoce,1,jwoxy))*1.e+6/jpoce,& 
    767          &MINVAL(pwcp(1:jpoce,1,jwoxy)*1.e+6/densSW(1:jpoce)) 
    768       WRITE(numsed,*)'[DIC]    dissolved (4) (k=1)(µmol/l)(and min value in mol/kg  of solution)' 
    769       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwdic))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwdic))*1.e+6,& 
    770          &SUM(pwcp(1:jpoce,1,jwdic))*1.e+6/jpoce,& 
    771          &MINVAL(pwcp(1:jpoce,1,jwdic)*1.e+6/densSW(1:jpoce)) 
    772       WRITE(numsed,*)'[NO3]    dissolved (5) (k=1)(µmol/l)(and min value in mol/kg  of solution)' 
    773       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwno3))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwno3))*1.e+6,& 
    774          &SUM(pwcp(1:jpoce,1,jwno3))*1.e+6/jpoce,& 
    775          &MINVAL(pwcp(1:jpoce,1,jwno3)*1.e+6/densSW(1:jpoce)) 
    776       WRITE(numsed,*)'[PO4]    dissolved (6) (k=1)(µmol/l)(and min value in mol/kg  of solution)' 
    777       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwpo4))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwpo4))*1.e+6,& 
    778          &SUM(pwcp(1:jpoce,1,jwpo4))*1.e+6/jpoce,& 
    779          &MINVAL(pwcp(1:jpoce,1,jwpo4)*1.e+6/densSW(1:jpoce)) 
    780       WRITE(numsed,*)'[Alk]    dissolved (7) (k=1)(µequi)(and min value in mol/kg  of solution)' 
    781       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwalk))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwalk))*1.e+6,& 
    782          &SUM(pwcp(1:jpoce,1,jwalk))*1.e+6/jpoce,& 
    783          &MINVAL(pwcp(1:jpoce,1,jwalk)*1.e+6/densSW(1:jpoce)) 
    784       WRITE(numsed,*)'[DIC13]  dissolved (8) (k=1)(µmol/l)(and min value in mol/kg  of solution)' 
    785       WRITE(numsed,'(4(F0.3,2X))') MINVAL(pwcp(1:jpoce,1,jwc13))*1.e+6,MAXVAL(pwcp(1:jpoce,1,jwc13))*1.e+6,& 
    786          &SUM(pwcp(1:jpoce,1,jwc13))*1.e+6/jpoce,& 
    787          &MINVAL(pwcp(1:jpoce,1,jwc13)*1.e+6/densSW(1:jpoce)) 
    788       WRITE(numsed,*)'' 
    789       WRITE(numsed,*)'     Solid Components ' 
    790       WRITE(numsed,*)'     =====================' 
    791       WRITE(numsed,*)'nmole of Opale rained per dt' 
    792       WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jsopal))*dtsed,MAXVAL(rainrm(1:jpoce,jsopal))*dtsed,& 
    793          &SUM(rainrm(1:jpoce,1))*dtsed/jpoce 
    794       WRITE(numsed,*)'nmole of Clay rained per dt' 
    795       WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jsclay))*dtsed,MAXVAL(rainrm(1:jpoce,jsclay))*dtsed,& 
    796          &SUM(rainrm(1:jpoce,jsclay))*dtsed/jpoce 
    797       WRITE(numsed,*)'nmole of POC rained per dt' 
    798       WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jspoc))*dtsed,MAXVAL(rainrm(1:jpoce,jspoc))*dtsed,& 
    799          &SUM(rainrm(1:jpoce,jspoc))*dtsed/jpoce 
    800       WRITE(numsed,*)'nmole of CaCO3 rained per dt' 
    801       WRITE(numsed,'(3(1PE9.3,2X))') MINVAL(rainrm(1:jpoce,jscal))*dtsed,MAXVAL(rainrm(1:jpoce,jscal))*dtsed,& 
    802          &SUM(rainrm(1:jpoce,jscal))*dtsed/jpoce 
    803       WRITE(numsed,*)' ' 
    804       WRITE(numsed,*)'Weight frac of opal rained (%) ' 
    805       WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100.,& 
    806          &MAXVAL(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100.,& 
    807          & SUM(rainrg(1:jpoce,jsopal)/raintg(1:jpoce))*100./jpoce 
    808       WRITE(numsed,*)'Weight frac of clay  rained (%) ' 
    809       WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100.,& 
    810          &MAXVAL(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100.,& 
    811          &SUM(rainrg(1:jpoce,jsclay)/raintg(1:jpoce))*100./jpoce 
    812       WRITE(numsed,*)'Weight frac of POC rained (%)' 
    813       WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100.,& 
    814          &MAXVAL(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100.,& 
    815          &SUM(rainrg(1:jpoce,jspoc)/raintg(1:jpoce))*100./jpoce 
    816       WRITE(numsed,*)'Weight frac of CaCO3  rained (%)' 
    817       WRITE(numsed,'(3(F0.3,7X))') MINVAL(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100.,& 
    818          &MAXVAL(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100.,& 
    819          &SUM(rainrg(1:jpoce,jscal)/raintg(1:jpoce))*100./jpoce 
    820       WRITE(numsed,*)'' 
    821       WRITE(numsed,*)' Thickness of sediment layer added by particule rain, dzdep cm ' 
    822       WRITE(numsed,*)' ==============================================================' 
    823       WRITE(numsed,'(3(F0.5,2X))') MINVAL(dzdep(1:jpoce)),MAXVAL(dzdep(1:jpoce)),SUM(dzdep(1:jpoce))/jpoce 
    824       WRITE(numsed,*)'' 
    825       WRITE(numsed,*)' chemical constants K1,pK1,K2,pK2,Kw,pKw and Kb pKb (min max) [mol/kgsol] or [mol/kgsol]2 ' 
    826       WRITE(numsed,*)' =========================================================================================' 
    827       WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(ak1s(1:jpoce)),MAXVAL(ak1s(1:jpoce)),-LOG10(MINVAL(ak1s(1:jpoce))),& 
    828          &-LOG10(MAXVAL(ak1s(1:jpoce))) 
    829       WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(ak2s(1:jpoce)),MAXVAL(ak2s(1:jpoce)),-LOG10(MINVAL(ak2s(1:jpoce))),& 
    830          &-LOG10(MAXVAL(ak2s(1:jpoce))) 
    831       WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(akws(1:jpoce)),MAXVAL(akws(1:jpoce)),-LOG10(MINVAL(akws(1:jpoce))),& 
    832          &-LOG10(MAXVAL(akws(1:jpoce))) 
    833       WRITE(numsed,'(4(1PE10.3,2X))')MINVAL(akbs(1:jpoce)),MAXVAL(akbs(1:jpoce)),-LOG10(MINVAL(akbs(1:jpoce))),& 
    834          &-LOG10(MAXVAL(akbs(1:jpoce))) 
    835       WRITE(numsed,*)'and boron' 
    836       WRITE(numsed,'(2(1PE10.3,2X))')MINVAL(borats(1:jpoce)),MAXVAL(borats(1:jpoce)) 
    837       WRITE(numsed,*)'' 
    838       WRITE(numsed,*)' Compo of initial sediment for point jpoce' 
    839       WRITE(numsed,*)' =========================================' 
    840       WRITE(numsed,*)'solcp(1),   solcp(2),   solcp(3),   solcp(4),   hipor,      pH,         co3por' 
    841       DO jk = 1,jpksed 
    842          WRITE(numsed,'(7(1PE10.3,2X))')solcp(jpoce,jk,jsopal),solcp(jpoce,jk,jsclay),solcp(jpoce,jk,jspoc),solcp(jpoce,jk,jscal),& 
    843             &       hipor(jpoce,jk),-LOG10(hipor(jpoce,jk)/densSW(jpoce)),co3por(jpoce,jk) 
    844       ENDDO 
    845       WRITE(numsed,'(A82)')'pwcp(1),    pwcp(2),    pwcp(3),    pwcp(4),    pwcp(5),    pwcp(6),    pwcp(7)' 
    846       DO jk = 1, jpksed 
    847          WRITE(numsed,'(7(1PE10.3,2X))')pwcp(jpoce,jk,jwsil),pwcp(jpoce,jk,jwoxy),pwcp(jpoce,jk,jwdic),& 
    848             & pwcp(jpoce,jk,jwno3),pwcp(jpoce,jk,jwpo4),pwcp(jpoce,jk,jwalk),pwcp(jpoce,jk,jwc13) 
    849       ENDDO 
    850       WRITE(numsed,*) ' ' 
    851       WRITE(numsed,*) ' End Of Initialization ' 
    852       WRITE(numsed,*) ' ' 
    853 ! 
    854    END SUBROUTINE sed_init_wri 
    855 #else 
    856    !!---------------------------------------------------------------------- 
    857    !!   Dummy module :                      NO Sediment model 
    858    !!---------------------------------------------------------------------- 
    859    !! $Id$ 
    860 CONTAINS 
    861    SUBROUTINE sed_ini              ! Empty routine 
    862    END SUBROUTINE sed_ini 
    863 #endif 
    864  
    865  
    866690END MODULE sedini 
  • NEMO/trunk/src/TOP/PISCES/SED/sedmat.F90

    r5215 r10222  
    11MODULE sedmat 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!              ***  MODULE  sedmat  *** 
     
    98 
    109   USE sed     ! sediment global variable 
     10   USE lib_mpp         ! distribued memory computing library 
     11 
    1112 
    1213   IMPLICIT NONE 
     
    2526 CONTAINS 
    2627 
    27     SUBROUTINE sed_mat_dsr( nvar, ndim, nlev, preac, psol ) 
     28    SUBROUTINE sed_mat_dsr( nvar, ndim, nlev, preac, psms, psol, dtsed_in ) 
    2829       !!--------------------------------------------------------------------- 
    2930       !!                  ***  ROUTINE sed_mat_dsr  *** 
     
    4849       !!---------------------------------------------------------------------- 
    4950       !! * Arguments 
    50        INTEGER , INTENT(in) ::  nvar  ! number of variables 
     51       INTEGER , INTENT(in) ::  nvar  ! number of variable 
    5152       INTEGER , INTENT(in) ::  ndim  ! number of points 
    5253       INTEGER , INTENT(in) ::  nlev  ! number of sediment levels 
    5354 
    54        REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(in   ) :: preac  ! reaction rates 
    55        REAL(wp), DIMENSION(ndim,nlev,nvar), INTENT(inout) :: psol   ! solution ( undersaturation values ) 
     55       REAL(wp), DIMENSION(ndim,nlev), INTENT(in   ) :: preac  ! reaction rates 
     56       REAL(wp), DIMENSION(ndim,nlev), INTENT(in   ) :: psms  ! reaction rates 
     57       REAL(wp), DIMENSION(ndim,nlev), INTENT(inout) :: psol   ! solution ( undersaturation values ) 
     58       REAL(wp), INTENT(in) ::  dtsed_in 
    5659  
    5760       !---Local declarations 
     
    6770       !---------------------------------------------------------------------- 
    6871 
     72       IF( ln_timing )  CALL timing_start('sed_mat_dsr') 
    6973 
    7074       ! Computation left hand side of linear system of  
     
    7377 
    7478 
     79       jn = nvar 
    7580       ! first sediment level           
    7681       DO ji = 1, ndim 
    77           aplus  = ( ( volw3d(ji,1) / dz3d(ji,1) ) + & 
    78                      ( volw3d(ji,2) / dz3d(ji,2) ) ) / 2. 
     82          aplus  = ( ( volw3d(ji,1) / ( dz3d(ji,1) ) ) + & 
     83                        ( volw3d(ji,2) / ( dz3d(ji,2) ) ) ) / 2. 
    7984          dxplus = ( dz3d(ji,1) + dz3d(ji,2) ) / 2. 
    80           rplus  = ( dtsed / volw3d(ji,1) ) * diff(1) * aplus / dxplus  
     85          rplus  = ( dtsed_in / ( volw3d(ji,1) ) ) * diff(ji,1,jn) * aplus / dxplus  
    8186 
    8287          za(ji,1) = 0. 
     
    8792       DO jk = 2, nlev - 1 
    8893          DO ji = 1, ndim 
    89              aminus  = ( ( volw3d(ji,jk-1) / dz3d(ji,jk-1) ) + & 
    90                 &        ( volw3d(ji,jk  ) / dz3d(ji,jk ) ) ) / 2. 
     94             aminus  = ( ( volw3d(ji,jk-1) / ( dz3d(ji,jk-1) ) ) + & 
     95             &        ( volw3d(ji,jk  ) / ( dz3d(ji,jk  ) ) ) ) / 2. 
    9196             dxminus = ( dz3d(ji,jk-1) + dz3d(ji,jk) ) / 2. 
    9297 
    93              aplus   = ( ( volw3d(ji,jk  ) / dz3d(ji,jk ) ) + & 
    94                 &        ( volw3d(ji,jk+1) / dz3d(ji,jk+1) ) ) / 2. 
     98             aplus   = ( ( volw3d(ji,jk  ) / ( dz3d(ji,jk  ) ) ) + & 
     99             &        ( volw3d(ji,jk+1) / ( dz3d(ji,jk+1) ) ) ) / 2. 
    95100             dxplus  = ( dz3d(ji,jk) + dz3d(ji,jk+1) ) / 2 
    96              ! 
    97              rminus  = ( dtsed / volw3d(ji,jk) ) * diff(jk-1) * aminus / dxminus 
    98              rplus   = ( dtsed / volw3d(ji,jk) ) * diff(jk)   * aplus / dxplus 
    99              !      
     101                ! 
     102             rminus  = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk-1,jn) * aminus / dxminus 
     103             rplus   = ( dtsed_in / volw3d(ji,jk) ) * diff(ji,jk,jn)   * aplus / dxplus 
     104                !      
    100105             za(ji,jk) = -rminus 
    101106             zb(ji,jk) = 1. + rminus + rplus  
     
    105110 
    106111       DO ji = 1, ndim 
    107           aminus  = ( ( volw3d(ji,nlev-1) / dz3d(ji,nlev-1) ) + & 
    108              &        ( volw3d(ji,nlev)  / dz3d(ji,nlev) ) ) / 2. 
     112          aminus  = ( ( volw3d(ji,nlev-1) / dz3d(ji,nlev-1)  ) + & 
     113          &        ( volw3d(ji,nlev)  / dz3d(ji,nlev) ) ) / 2. 
    109114          dxminus = ( dz3d(ji,nlev-1) + dz3d(ji,nlev) ) / 2. 
    110           rminus  = ( dtsed / volw3d(ji,nlev) ) * diff(nlev-1) * aminus / dxminus 
     115          rminus  = ( dtsed_in / volw3d(ji,nlev) ) * diff(ji,nlev-1,jn) * aminus / dxminus 
    111116