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

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

Changeset 10975 for NEMO/branches/2019


Ignore:
Timestamp:
2019-05-13T18:34:33+02:00 (5 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Finish converting all TOP routines and knock-on effects of these conversions. Fully SETTE tested (SETTE tests 1-6 and 9). This completes the first stage conversion of TRA and TOP but need to revisit and pass ts and tr arrays through the argument lists where appropriate.

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
Files:
57 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/SAS/step.F90

    r10922 r10975  
    101101      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.   
    102102      !           This is not clean and should be changed in the future.  
    103       IF( ln_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
     103      IF( ln_bdy     )       CALL bdy_dta ( kstp,     Nnn, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    104104      ! ==> 
    105                              CALL sbc    ( kstp, Nbb, Nnn )         ! Sea Boundary Condition (including sea-ice) 
     105                             CALL sbc    ( kstp, Nbb, Nnn )                   ! Sea Boundary Condition (including sea-ice) 
    106106 
    107107                             CALL dia_wri( kstp )         ! ocean model: outputs 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/AGE/trcini_age.F90

    r10070 r10975  
    2525CONTAINS 
    2626 
    27    SUBROUTINE trc_ini_age 
     27   SUBROUTINE trc_ini_age( Kmm ) 
    2828      !!---------------------------------------------------------------------- 
    2929      !!                     ***  trc_ini_age  ***   
    … …  
    3232      !! 
    3333      !!---------------------------------------------------------------------- 
     34      INTEGER, INTENT(in) ::   Kmm ! time level indices 
    3435      INTEGER    ::  jn 
    3536      CHARACTER(len = 20)  ::  cltra 
    … …  
    5758 
    5859       
    59       IF( .NOT. ln_rsttr ) trn(:,:,:,jp_age) = 0. 
     60      IF( .NOT. ln_rsttr ) tr(:,:,:,jp_age,Kmm) = 0. 
    6061      ! 
    6162   END SUBROUTINE trc_ini_age 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/AGE/trcsms_age.F90

    r10966 r10975  
    3737CONTAINS 
    3838 
    39    SUBROUTINE trc_sms_age( kt, Kmm ) 
     39   SUBROUTINE trc_sms_age( kt, Kbb, Kmm, Krhs ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                     ***  trc_sms_age  *** 
    … …  
    4545      !! ** Method  : - 
    4646      !!---------------------------------------------------------------------- 
    47       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    48       INTEGER, INTENT(in) ::   Kmm  ! ocean time level 
     47      INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
     48      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! ocean time level 
    4949      INTEGER ::   jn, jk   ! dummy loop index 
    5050      !!---------------------------------------------------------------------- 
    … …  
    5858 
    5959      DO jk = 1, nla_age 
    60          tra(:,:,jk,jp_age) = rn_age_kill_rate * trb(:,:,jk,jp_age) 
     60         tr(:,:,jk,jp_age,Krhs) = rn_age_kill_rate * tr(:,:,jk,jp_age,Kbb) 
    6161      END DO 
    6262      ! 
    63       tra(:,:,nl_age,jp_age) = frac_kill_age * rn_age_kill_rate * trb(:,:,nl_age,jp_age)  & 
     63      tr(:,:,nl_age,jp_age,Krhs) = frac_kill_age * rn_age_kill_rate * tr(:,:,nl_age,jp_age,Kbb)  & 
    6464          &                   + frac_add_age  * rryear * tmask(:,:,nl_age) 
    6565      ! 
    6666      DO jk = nlb_age, jpk 
    67          tra(:,:,jk,jp_age) = tmask(:,:,jk) * rryear 
     67         tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear 
    6868      END DO 
    6969      ! 
    70       IF( l_trdtrc ) CALL trd_trc( tra(:,:,:,jp_age), jn, jptra_sms, kt, Kmm )   ! save trends 
     70      IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    7171      ! 
    7272      IF( ln_timing )   CALL timing_stop('trc_sms_age') 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/AGE/trcwri_age.F90

    r10070 r10975  
    2121CONTAINS 
    2222 
    23    SUBROUTINE trc_wri_age 
     23   SUBROUTINE trc_wri_age( Kmm ) 
    2424      !!--------------------------------------------------------------------- 
    2525      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    2727      !! ** Purpose :   output passive tracers fields  
    2828      !!--------------------------------------------------------------------- 
     29      INTEGER, INTENT(in)  :: Kmm  ! time level indices 
    2930      CHARACTER (len=20)   :: cltra 
    3031      INTEGER              :: jn 
    … …  
    3435 
    3536      cltra = TRIM( ctrcnm(jp_age) )                  ! short title for tracer 
    36       CALL iom_put( cltra, trn(:,:,:,jp_age) ) 
     37      CALL iom_put( cltra, tr(:,:,:,jp_age,Kmm) ) 
    3738 
    3839      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/C14/trcini_c14.F90

    r10069 r10975  
    3131CONTAINS 
    3232 
    33    SUBROUTINE trc_ini_c14 
     33   SUBROUTINE trc_ini_c14( Kmm ) 
    3434      !!---------------------------------------------------------------------- 
    3535      !!                     ***  trc_ini_c14  ***   
    … …  
    4040      !!---------------------------------------------------------------------- 
    4141      ! 
     42      INTEGER, INTENT(in)  ::  Kmm  ! time level indices 
    4243      REAL(wp) :: ztrai 
    4344      INTEGER  :: jn 
    … …  
    5758         IF(lwp) WRITE(numout,*) '                      ==>    Ocean C14/C :', rc14init  
    5859         ! 
    59          trn(:,:,:,jp_c14) = rc14init * tmask(:,:,:) 
     60         tr(:,:,:,jp_c14,Kmm) = rc14init * tmask(:,:,:) 
    6061         ! 
    6162         qtr_c14(:,:) = 0._wp           ! Init of air-sea BC 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/C14/trcsms_c14.F90

    r10966 r10975  
    3333CONTAINS 
    3434 
    35    SUBROUTINE trc_sms_c14( kt, Kmm ) 
     35   SUBROUTINE trc_sms_c14( kt, Kbb, Kmm, Krhs ) 
    3636      !!---------------------------------------------------------------------- 
    3737      !!                  ***  ROUTINE trc_sms_c14  *** 
    … …  
    4646      !            freshwater fluxes which should not impact the C14/C ratio 
    4747      ! 
    48       !        =>   Delta-C14= ( trn(...jp_c14) -1)*1000. 
     48      !        =>   Delta-C14= ( tr(...jp_c14,Kmm) -1)*1000. 
    4949      !! 
    5050      !!---------------------------------------------------------------------- 
    5151      ! 
    52       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    53       INTEGER, INTENT(in) ::   Kmm   ! ocean time level 
     52      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     53      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    5454      ! 
    55       INTEGER  :: ji, jj, jk         ! dummy loop indices  
     55      INTEGER  :: ji, jj, jk        ! dummy loop indices  
    5656      REAL(wp) :: zt, ztp, zsk      ! dummy variables 
    5757      REAL(wp) :: zsol              ! solubility 
    … …  
    8282            IF( tmask(ji,jj,1) >  0. ) THEN 
    8383               ! 
    84                zt   = MIN( 40. , tsn(ji,jj,1,jp_tem) ) 
     84               zt   = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 
    8585               ! 
    8686               !  Computation of solubility zsol in [mol/(L * atm)] 
    … …  
    8888               ztp  = ( zt + 273.16 ) * 0.01 
    8989               zsk  = 0.027766 + ztp * ( -0.025888 + 0.0050578 * ztp )   ! [mol/(L * atm)] 
    90                zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 
     90               zsol = EXP( -58.0931 + 90.5069 / ztp  + 22.2940 * LOG( ztp ) + zsk * ts(ji,jj,1,jp_sal,Kmm) ) 
    9191               ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 
    9292               zsol = zsol * 1.e-03 
    … …  
    121121      ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s 
    122122      !                               already masked 
    123       qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - trb(:,:,1,jp_c14) ) 
     123      qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) ) 
    124124             
    125125      ! cumulation of air-to-sea flux at each time step 
    … …  
    129129      DO jj = 1, jpj 
    130130         DO ji = 1, jpi 
    131             tra(ji,jj,1,jp_c14) = tra(ji,jj,1,jp_c14) + qtr_c14(ji,jj) / e3t_n(ji,jj,1)  
     131            tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)  
    132132         END DO 
    133133      END DO 
    … …  
    138138            DO ji = 1, jpi 
    139139               ! 
    140                tra(ji,jj,jk,jp_c14) = tra(ji,jj,jk,jp_c14) - rlam14 * trb(ji,jj,jk,jp_c14) * tmask(ji,jj,jk)  
     140               tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk)  
    141141               ! 
    142142            END DO 
    … …  
    158158      ENDIF 
    159159 
    160       IF( l_trdtrc )  CALL trd_trc( tra(:,:,:,jp_c14), 1, jptra_sms, kt, Kmm )   ! save trends 
     160      IF( l_trdtrc )  CALL trd_trc( tr(:,:,:,jp_c14,Krhs), 1, jptra_sms, kt, Kmm )   ! save trends 
    161161      ! 
    162162      IF( ln_timing )   CALL timing_stop('trc_sms_c14') 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/C14/trcwri_c14.F90

    r10425 r10975  
    2727CONTAINS 
    2828 
    29    SUBROUTINE trc_wri_c14 
     29   SUBROUTINE trc_wri_c14( Kmm ) 
    3030      !!--------------------------------------------------------------------- 
    3131      !!                     ***  ROUTINE trc_wri_c14  *** 
    … …  
    3333      !! ** Purpose :   output additional C14 tracers fields  
    3434      !!--------------------------------------------------------------------- 
     35      INTEGER, INTENT(in)  :: Kmm           ! time level indices 
    3536      CHARACTER (len=20)   :: cltra         ! short title for tracer 
    3637      INTEGER              :: ji,jj,jk,jn   ! dummy loop indexes 
    … …  
    4344      ! --------------------------------------- 
    4445      cltra = TRIM( ctrcnm(jp_c14) )                  ! short title for tracer 
    45       CALL iom_put( cltra, trn(:,:,:,jp_c14) ) 
     46      CALL iom_put( cltra, tr(:,:,:,jp_c14,Kmm) ) 
    4647 
    4748      ! compute and write the tracer diagnostic in the file 
    … …  
    6162               DO ji = 1, jpi 
    6263                  IF( tmask(ji,jj,jk) > 0._wp) THEN 
    63                      z3d (ji,jj,jk) = trn(ji,jj,jk,jp_c14) 
     64                     z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 
    6465                     zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 
    6566                  ENDIF 
    … …  
    113114      ENDIF 
    114115      IF( iom_use("C14Inv") ) THEN 
    115          ztemp = glob_sum( 'trcwri_c14', trn(:,:,:,jp_c14) * cvol(:,:,:) ) 
     116         ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) ) 
    116117         ztemp = atomc14 * xdicsur * ztemp 
    117118         CALL iom_put( "C14Inv", ztemp )  !  Radiocarbon ocean inventory [10^26 atoms] 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/CFC/trcini_cfc.F90

    r10068 r10975  
    3131CONTAINS 
    3232 
    33    SUBROUTINE trc_ini_cfc 
     33   SUBROUTINE trc_ini_cfc( Kmm ) 
    3434      !!---------------------------------------------------------------------- 
    3535      !!                     ***  trc_ini_cfc  ***   
    … …  
    3939      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    4040      !!---------------------------------------------------------------------- 
     41      INTEGER, INTENT(in)  ::  Kmm  ! time level indices 
    4142      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr 
    42       INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
     43      INTEGER  ::  iskip = 6        ! number of 1st descriptor lines 
    4344      REAL(wp) ::  zyy, zyd 
    4445      CHARACTER(len = 20)  ::  cltra 
    … …  
    9091         DO jl = 1, jp_cfc 
    9192            jn = jp_cfc0 + jl - 1 
    92             trn(:,:,:,jn) = 0._wp 
     93            tr(:,:,:,jn,Kmm) = 0._wp 
    9394         END DO 
    9495      ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/CFC/trcsms_cfc.F90

    r10966 r10975  
    5454CONTAINS 
    5555 
    56    SUBROUTINE trc_sms_cfc( kt, Kmm ) 
     56   SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs ) 
    5757      !!---------------------------------------------------------------------- 
    5858      !!                     ***  ROUTINE trc_sms_cfc  *** 
    … …  
    7070      !!                CFC concentration in pico-mol/m3 
    7171      !!---------------------------------------------------------------------- 
    72       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    73       INTEGER, INTENT(in) ::   Kmm   ! ocean time level 
     72      INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
     73      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level 
    7474      ! 
    7575      INTEGER  ::   ji, jj, jn, jl, jm 
    … …  
    129129               ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
    130130               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
    131                   ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 
     131                  ztap  = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 
    132132                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
    133133                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
    134                      &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap )  
     134                     &                    + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap )  
    135135               ELSE 
    136136                  zsol  = 0.e0 
    … …  
    143143               ! Computation of speed transfert 
    144144               !    Schmidt number revised in Wanninkhof (2014) 
    145                zt1  = tsn(ji,jj,1,jp_tem) 
     145               zt1  = ts(ji,jj,1,jp_tem,Kmm) 
    146146               zt2  = zt1 * zt1  
    147147               zt3  = zt1 * zt2 
    … …  
    155155 
    156156               ! Input function  : speed *( conc. at equil - concen at surface ) 
    157                ! trn in pico-mol/l idem qtr; ak in en m/a 
    158                qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
     157               ! tr(:,:,:,:,Kmm) in pico-mol/l idem qtr; ak in en m/a 
     158               qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr(ji,jj,1,jn,Kbb) - zca_cfc )   & 
    159159                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    160160               ! Add the surface flux to the trend 
    161                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / e3t_n(ji,jj,1)  
     161               tr(ji,jj,1,jn,Krhs) = tr(ji,jj,1,jn,Krhs) + qtr_cfc(ji,jj,jl) / e3t(ji,jj,1,Kmm)  
    162162 
    163163               ! cumulation of surface flux at each time step 
    … …  
    192192      IF( l_trdtrc ) THEN 
    193193          DO jn = jp_cfc0, jp_cfc1 
    194             CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt, Kmm )   ! save trends 
     194            CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    195195          END DO 
    196196      END IF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/CFC/trcwri_cfc.F90

    r10069 r10975  
    2020CONTAINS 
    2121 
    22    SUBROUTINE trc_wri_cfc 
     22   SUBROUTINE trc_wri_cfc( Kmm ) 
    2323      !!--------------------------------------------------------------------- 
    2424      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    2626      !! ** Purpose :   output passive tracers fields  
    2727      !!--------------------------------------------------------------------- 
     28      INTEGER, INTENT(in)  :: Kmm   ! time level indices 
    2829      CHARACTER (len=20)   :: cltra 
    2930      INTEGER              :: jn 
    … …  
    3435      DO jn = jp_cfc0, jp_cfc1 
    3536         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    36          CALL iom_put( cltra, trn(:,:,:,jn) ) 
     37         CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    3738      END DO 
    3839      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC/trcini_my_trc.F90

    r10068 r10975  
    2828CONTAINS 
    2929 
    30    SUBROUTINE trc_ini_my_trc 
     30   SUBROUTINE trc_ini_my_trc( Kmm ) 
    3131      !!---------------------------------------------------------------------- 
    3232      !!                     ***  trc_ini_my_trc  ***   
    … …  
    3636      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    3737      !!---------------------------------------------------------------------- 
     38      INTEGER, INTENT(in) ::   Kmm  ! time level indices 
    3839      ! 
    3940      CALL trc_nam_my_trc 
    … …  
    5051      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    5152       
    52       IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1. 
     53      IF( .NOT. ln_rsttr ) tr(:,:,:,jp_myt0:jp_myt1,Kmm) = 1. 
    5354      ! 
    5455   END SUBROUTINE trc_ini_my_trc 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC/trcsms_my_trc.F90

    r10966 r10975  
    3232CONTAINS 
    3333 
    34    SUBROUTINE trc_sms_my_trc( kt, Kmm, Krhs ) 
     34   SUBROUTINE trc_sms_my_trc( kt, Kbb, Kmm, Krhs ) 
    3535      !!---------------------------------------------------------------------- 
    3636      !!                     ***  trc_sms_my_trc  *** 
    … …  
    4242      ! 
    4343      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    44       INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices 
     44      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    4545      INTEGER ::   jn   ! dummy loop index 
    4646      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt 
    … …  
    6262      IF( l_trdtrc ) THEN 
    6363          DO jn = jp_myt0, jp_myt1 
    64             ztrmyt(:,:,:) = tra(:,:,:,jn) 
     64            ztrmyt(:,:,:) = tr(:,:,:,jn,Krhs) 
    6565            CALL trd_trc( ztrmyt, jn, jptra_sms, kt, Kmm )   ! save trends 
    6666          END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC/trcwri_my_trc.F90

    r10069 r10975  
    2525CONTAINS 
    2626 
    27    SUBROUTINE trc_wri_my_trc 
     27   SUBROUTINE trc_wri_my_trc( Kmm ) 
    2828      !!--------------------------------------------------------------------- 
    2929      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    3131      !! ** Purpose :   output passive tracers fields  
    3232      !!--------------------------------------------------------------------- 
     33      INTEGER, INTENT(in)  :: Kmm   ! time level indices 
    3334      CHARACTER (len=20)   :: cltra 
    3435      INTEGER              :: jn 
    … …  
    3940      DO jn = jp_myt0, jp_myt1 
    4041         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    41          CALL iom_put( cltra, trn(:,:,:,jn) ) 
     42         CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    4243      END DO 
    4344      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zbio.F90

    r10425 r10975  
    6565CONTAINS 
    6666 
    67    SUBROUTINE p2z_bio( kt ) 
     67   SUBROUTINE p2z_bio( kt, Kmm, Krhs ) 
    6868      !!--------------------------------------------------------------------- 
    6969      !!                     ***  ROUTINE p2z_bio  *** 
    … …  
    7878      !!              is added to the general trend. 
    7979      !!         
    80       !!                      tra = tra + zf...tra - zftra... 
     80      !!                      tr(Krhs) = tr(Krhs) + zf...tr(Krhs) - zftra... 
    8181      !!                                     |         | 
    8282      !!                                     |         | 
    … …  
    8484      !!         
    8585      !!--------------------------------------------------------------------- 
    86       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     86      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index       
     87      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices 
    8788      ! 
    8889      INTEGER  ::   ji, jj, jk, jl 
    … …  
    126127 
    127128               ! negative trophic variables DO not contribute to the fluxes 
    128                zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 
    129                zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 
    130                zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 
    131                zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 
    132                znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 
    133                zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 
     129               zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
     130               zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
     131               zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
     132               zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
     133               znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
     134               zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
    134135 
    135136               ! Limitations 
    … …  
    176177               !    closure : flux grazing is redistributed below level jpkbio 
    177178               zzoobod = tmminz * zzoo * zzoo 
    178                xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t_n(ji,jj,jk) 
     179               xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * e3t(ji,jj,jk,Kmm) 
    179180               zboddet = fdbod * zzoobod 
    180181 
    … …  
    202203 
    203204               ! tracer flux at totox-point added to the general trend 
    204                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    205                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    206                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    207                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    208                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    209                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
     205               tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
     206               tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
     207               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
     208               tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
     209               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
     210               tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
    210211 
    211212                IF( lk_iomput ) THEN 
    212213                  ! convert fluxes in per day 
    213                   ze3t = e3t_n(ji,jj,jk) * 86400._wp 
     214                  ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
    214215                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    215216                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    … …  
    248249               !    trophic variables( det, zoo, phy, no3, nh4, dom) 
    249250               !       negative trophic variables DO not contribute to the fluxes 
    250                zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 
    251                zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 
    252                zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 
    253                zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 
    254                znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 
    255                zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 
     251               zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) 
     252               zzoo = MAX( 0.e0, tr(ji,jj,jk,jpzoo,Kmm) ) 
     253               zphy = MAX( 0.e0, tr(ji,jj,jk,jpphy,Kmm) ) 
     254               zno3 = MAX( 0.e0, tr(ji,jj,jk,jpno3,Kmm) ) 
     255               znh4 = MAX( 0.e0, tr(ji,jj,jk,jpnh4,Kmm) ) 
     256               zdom = MAX( 0.e0, tr(ji,jj,jk,jpdom,Kmm) ) 
    256257 
    257258               !    Limitations 
    … …  
    304305 
    305306               ! tracer flux at totox-point added to the general trend 
    306                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    307                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    308                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    309                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    310                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    311                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
     307               tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + zdeta 
     308               tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zzooa 
     309               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zphya 
     310               tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zno3a 
     311               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + znh4a 
     312               tr(ji,jj,jk,jpdom,Krhs) = tr(ji,jj,jk,jpdom,Krhs) + zdoma 
    312313               ! 
    313314                IF( lk_iomput ) THEN                  ! convert fluxes in per day 
    314                   ze3t = e3t_n(ji,jj,jk) * 86400._wp 
     315                  ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 
    315316                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
    316317                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    … …  
    370371         WRITE(charout, FMT="('bio')") 
    371372         CALL prt_ctl_trc_info(charout) 
    372          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     373         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    373374      ENDIF 
    374375      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zexp.F90

    r10425 r10975  
    4646CONTAINS 
    4747 
    48    SUBROUTINE p2z_exp( kt ) 
     48   SUBROUTINE p2z_exp( kt, Kmm, Krhs ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !!                     ***  ROUTINE p2z_exp  *** 
    … …  
    6060      !!--------------------------------------------------------------------- 
    6161      !! 
    62       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     62      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index       
     63      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices 
    6364      !! 
    6465      INTEGER  ::   ji, jj, jk, jl, ikt 
    … …  
    7071      IF( ln_timing )   CALL timing_start('p2z_exp') 
    7172      ! 
    72       IF( kt == nittrc000 )   CALL p2z_exp_init 
     73      IF( kt == nittrc000 )   CALL p2z_exp_init( Kmm ) 
    7374 
    7475      zsedpoca(:,:) = 0. 
    … …  
    8384         DO jj = 2, jpjm1 
    8485            DO ji = fs_2, fs_jpim1 
    85                ze3t = 1. / e3t_n(ji,jj,jk) 
    86                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
     86               ze3t = 1. / e3t(ji,jj,jk,Kmm) 
     87               tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
    8788            END DO 
    8889         END DO 
    … …  
    9899         DO ji = fs_2, fs_jpim1 
    99100            ikt = mbkt(ji,jj)  
    100             tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt)  
     101            tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm)  
    101102            ! Deposition of organic matter in the sediment 
    102             zwork = vsed * trn(ji,jj,ikt,jpdet) 
     103            zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 
    103104            zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
    104105               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    … …  
    109110      DO jj = 2, jpjm1 
    110111         DO ji = fs_2, fs_jpim1 
    111             tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1) 
     112            tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 
    112113         END DO 
    113114      END DO 
    … …  
    149150         WRITE(charout, FMT="('exp')") 
    150151         CALL prt_ctl_trc_info(charout) 
    151          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     152         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    152153      ENDIF 
    153154      ! 
    … …  
    157158 
    158159 
    159    SUBROUTINE p2z_exp_init 
     160   SUBROUTINE p2z_exp_init( Kmm ) 
    160161      !!---------------------------------------------------------------------- 
    161162      !!                    ***  ROUTINE p4z_exp_init  *** 
    162163      !! ** purpose :   specific initialisation for export 
    163164      !!---------------------------------------------------------------------- 
     165      INTEGER, INTENT(in)  ::  Kmm      ! time level index 
    164166      INTEGER  ::   ji, jj, jk 
    165167      REAL(wp) ::   zmaskt, zfluo, zfluu 
    … …  
    184186         DO jj = 1, jpj 
    185187            DO ji = 1, jpi 
    186                zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr 
    187                zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr 
     188               zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     189               zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    188190               IF( zfluo.GT.1. )   zfluo = 1._wp 
    189191               zdm0(ji,jj,jk) = zfluo - zfluu 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zopt.F90

    r10068 r10975  
    4545CONTAINS 
    4646 
    47    SUBROUTINE p2z_opt( kt ) 
     47   SUBROUTINE p2z_opt( kt, Kmm ) 
    4848      !!--------------------------------------------------------------------- 
    4949      !!                     ***  ROUTINE p2z_opt  *** 
    … …  
    6161      !! 
    6262      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
     63      INTEGER, INTENT( in ) ::   Kmm  ! time level index 
    6364      !! 
    6465      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    9495         DO jj = 1, jpj 
    9596            DO ji = 1, jpi 
    96                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  ) 
     97               zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  ) 
    9798               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    9899               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    99                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t_n(ji,jj,jk-1) ) 
    100                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t_n(ji,jj,jk-1) ) 
     100               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) ) 
     101               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 
    101102            END DO 
    102103        END DO 
    … …  
    105106         DO jj = 1, jpj 
    106107            DO ji = 1, jpi 
    107                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  ) 
     108               zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  ) 
    108109               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    109110               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    110                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkr * e3t_n(ji,jj,jk) ) ) 
    111                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t_n(ji,jj,jk) ) * ( 1 - EXP( -zkg * e3t_n(ji,jj,jk) ) ) 
     111               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) ) 
     112               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) ) 
    112113               etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
    113114            END DO 
    … …  
    128129      DO jj = 1, jpj 
    129130         DO ji = 1, jpi 
    130             heup(ji,jj) = gdepw_n(ji,jj,neln(ji,jj)) 
     131            heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 
    131132         END DO 
    132133      END DO  
    … …  
    136137         WRITE(charout, FMT="('opt')") 
    137138         CALL prt_ctl_trc_info( charout ) 
    138          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     139         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
    139140      ENDIF 
    140141      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zsed.F90

    r10068 r10975  
    3838CONTAINS 
    3939 
    40    SUBROUTINE p2z_sed( kt ) 
     40   SUBROUTINE p2z_sed( kt, Kmm, Krhs ) 
    4141      !!--------------------------------------------------------------------- 
    4242      !!                     ***  ROUTINE p2z_sed  *** 
    … …  
    4949      !!              using an upstream scheme 
    5050      !!              the now vertical advection of tracers is given by: 
    51       !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) ) 
    52       !!              add this trend now to the general trend of tracer (ta,sa,tra): 
    53       !!                             tra = tra + dz(trn wn) 
     51      !!                      dz(tr(:,:,:,:,Kmm) ww) = 1/bt dk+1( e1t e2t vsed (tr(:,:,:,:,Kmm)) ) 
     52      !!              add this trend now to the general trend of tracer (ta,sa,tr(:,:,:,:,Krhs)): 
     53      !!                             tr(:,:,:,:,Krhs) = tr(:,:,:,:,Krhs) + dz(tr(:,:,:,:,Kmm) ww) 
    5454      !!         
    5555      !!              IF 'key_diabio' is defined, the now vertical advection 
    5656      !!              trend of passive tracers is saved for futher diagnostics. 
    5757      !!--------------------------------------------------------------------- 
    58       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     58      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index       
     59      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices 
    5960      ! 
    6061      INTEGER  ::   ji, jj, jk, jl, ierr 
    … …  
    8182      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    8283      DO jk = 2, jpkm1 
    83          zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 
     84         zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm) 
    8485      END DO 
    8586 
    … …  
    8889         DO jj = 1, jpj 
    8990            DO ji = 1, jpi 
    90                ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    91                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk)  
     91               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     92               tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk)  
    9293            END DO 
    9394         END DO 
    … …  
    9798         IF( iom_use( "TDETSED" ) ) THEN 
    9899            ALLOCATE( zw2d(jpi,jpj) ) 
    99             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
     100            zw2d(:,:) =  ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp 
    100101            DO jk = 2, jpkm1 
    101                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
     102               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp 
    102103            END DO 
    103104            CALL iom_put( "TDETSED", zw2d ) 
    … …  
    110111         WRITE(charout, FMT="('sed')") 
    111112         CALL prt_ctl_trc_info(charout) 
    112          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     113         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    113114      ENDIF 
    114115      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zsms.F90

    r10966 r10975  
    3535CONTAINS 
    3636 
    37    SUBROUTINE p2z_sms( kt, Kmm ) 
     37   SUBROUTINE p2z_sms( kt, Kmm, Krhs ) 
    3838      !!--------------------------------------------------------------------- 
    3939      !!                     ***  ROUTINE p2z_sms  *** 
    … …  
    4444      !! ** Method  : - ??? 
    4545      !! -------------------------------------------------------------------- 
    46       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    47       INTEGER, INTENT( in ) ::   Kmm     ! ocean time level index       
     46      INTEGER, INTENT( in ) ::   kt            ! ocean time-step index       
     47      INTEGER, INTENT( in ) ::   Kmm, Krhs     ! ocean time level index       
    4848      ! 
    4949      INTEGER ::   jn   ! dummy loop index 
    … …  
    5252      IF( ln_timing )   CALL timing_start('p2z_sms') 
    5353      ! 
    54       CALL p2z_opt( kt )      ! optical model 
    55       CALL p2z_bio( kt )      ! biological model 
    56       CALL p2z_sed( kt )      ! sedimentation model 
    57       CALL p2z_exp( kt )      ! export 
     54      CALL p2z_opt( kt, Kmm      )      ! optical model 
     55      CALL p2z_bio( kt, Kmm, Krhs )      ! biological model 
     56      CALL p2z_sed( kt, Kmm, Krhs )      ! sedimentation model 
     57      CALL p2z_exp( kt, Kmm, Krhs )      ! export 
    5858      ! 
    5959      IF( l_trdtrc ) THEN 
    6060         DO jn = jp_pcs0, jp_pcs1 
    61            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt, Kmm )   ! save trends 
     61           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    6262         END DO 
    6363      END IF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zagg.F90

    r10069 r10975  
    3131CONTAINS 
    3232 
    33    SUBROUTINE p4z_agg ( kt, knt ) 
     33   SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs ) 
    3434      !!--------------------------------------------------------------------- 
    3535      !!                     ***  ROUTINE p4z_agg  *** 
    … …  
    4040      !!--------------------------------------------------------------------- 
    4141      INTEGER, INTENT(in) ::   kt, knt   ! 
     42      INTEGER, INTENT(in) ::   Kbb, Krhs ! time level indices 
    4243      ! 
    4344      INTEGER  ::   ji, jj, jk 
    … …  
    6364                  zfact = xstep * xdiss(ji,jj,jk) 
    6465                  !  Part I : Coagulation dependent on turbulence 
    65                   zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
    66                   zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
     66                  zagg1 = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 
     67                  zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 
    6768 
    6869                  ! Part II : Differential settling 
    6970 
    7071                  !  Aggregation of small into large particles 
    71                   zagg3 =  47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
    72                   zagg4 =  3.3  * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
     72                  zagg3 =  47.1 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb) 
     73                  zagg4 =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb) 
    7374 
    7475                  zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    75                   zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
     76                  zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
    7677 
    7778                  ! Aggregation of DOC to POC :  
    … …  
    7980                  ! 2nd term is shear aggregation of DOC-POC 
    8081                  ! 3rd term is differential settling of DOC-POC 
    81                   zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       & 
    82                   &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc) 
     82                  zaggdoc  = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       & 
     83                  &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    8384                  ! transfer of DOC to GOC :  
    8485                  ! 1st term is shear aggregation 
    8586                  ! 2nd term is differential settling  
    86                   zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 
     87                  zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    8788                  ! tranfer of DOC to POC due to brownian motion 
    88                   zaggdoc3 =  114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc) 
     89                  zaggdoc3 =  114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) *xstep * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
    8990 
    9091                  !  Update the trends 
    91                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 
    92                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    93                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    94                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    95                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
     92                  tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zagg + zaggdoc + zaggdoc3 
     93                  tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zagg + zaggdoc2 
     94                  tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 
     95                  tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 
     96                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 
    9697                  ! 
    9798                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 
    … …  
    109110                  zfact = xstep * xdiss(ji,jj,jk) 
    110111                  !  Part I : Coagulation dependent on turbulence 
    111                   zaggtmp = 25.9  * zfact * trb(ji,jj,jk,jppoc) 
    112                   zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc) 
    113                   zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc) 
    114                   zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc) 
     112                  zaggtmp = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) 
     113                  zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     114                  zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb) 
     115                  zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    115116 
    116117                  ! Part II : Differential settling 
    117118    
    118119                  !  Aggregation of small into large particles 
    119                   zaggtmp =  47.1 * xstep * trb(ji,jj,jk,jpgoc) 
    120                   zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc) 
    121                   zaggtmp =  3.3  * xstep * trb(ji,jj,jk,jppoc) 
    122                   zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc) 
     120                  zaggtmp =  47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb) 
     121                  zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
     122                  zaggtmp =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) 
     123                  zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb) 
    123124 
    124125                  zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 
    125                   zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    126                   zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    127                   zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc)  + rtrn ) 
     126                  zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     127                  zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     128                  zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb)  + rtrn ) 
    128129 
    129130                  ! Aggregation of DOC to POC :  
    … …  
    131132                  ! 2nd term is shear aggregation of DOC-POC 
    132133                  ! 3rd term is differential settling of DOC-POC 
    133                   zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       & 
    134                   &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) 
    135                   zaggdoc  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 
    136                   zaggdon  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 
    137                   zaggdop  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 
     134                  zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       & 
     135                  &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) 
     136                  zaggdoc  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     137                  zaggdon  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
     138                  zaggdop  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
    138139 
    139140                  ! transfer of DOC to GOC :  
    140141                  ! 1st term is shear aggregation 
    141142                  ! 2nd term is differential settling  
    142                   zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) 
    143                   zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 
    144                   zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 
    145                   zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 
     143                  zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) 
     144                  zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     145                  zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
     146                  zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
    146147 
    147148                  ! tranfer of DOC to POC due to brownian motion 
    148                   zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep 
    149                   zaggdoc3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) 
    150                   zaggdon3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) 
    151                   zaggdop3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) 
     149                  zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep 
     150                  zaggdoc3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) 
     151                  zaggdon3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb) 
     152                  zaggdop3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb) 
    152153 
    153154                  !  Update the trends 
    154                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3 
    155                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3 
    156                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3 
    157                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2 
    158                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2 
    159                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2 
    160                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    161                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    162                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    163                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3 
    164                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3 
     155                  tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3 
     156                  tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3 
     157                  tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3 
     158                  tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2 
     159                  tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2 
     160                  tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2 
     161                  tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe 
     162                  tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe 
     163                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3 
     164                  tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3 
     165                  tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3 
    165166                  ! 
    166167                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 
    … …  
    176177         WRITE(charout, FMT="('agg')") 
    177178         CALL prt_ctl_trc_info(charout) 
    178          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     179         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    179180      ENDIF 
    180181      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zbio.F90

    r10966 r10975  
    4545CONTAINS 
    4646 
    47    SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm ) 
     47   SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm, Krhs ) 
    4848      !!--------------------------------------------------------------------- 
    4949      !!                     ***  ROUTINE p4z_bio  *** 
    … …  
    5656      !!--------------------------------------------------------------------- 
    5757      INTEGER, INTENT(in) :: kt, knt 
    58       INTEGER, INTENT(in) :: Kbb, Kmm  ! time level indices 
     58      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices 
    5959      ! 
    6060      INTEGER             :: ji, jj, jk, jn 
    … …  
    7373            DO ji = 1, jpi 
    7474!!gm  :  use nmln  and test on jk ...  less memory acces 
    75                IF( gdepw_n(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
     75               IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01 
    7676            END DO  
    7777         END DO 
    7878      END DO 
    7979 
    80       CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column 
    81       CALL p4z_sink    ( kt, knt, Kbb, Kmm )     ! vertical flux of particulate organic matter 
    82       CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging 
     80      CALL p4z_opt     ( kt, knt, Kbb,      Krhs )     ! Optic: PAR in the water column 
     81      CALL p4z_sink    ( kt, knt, Kbb, Kmm, Krhs )     ! vertical flux of particulate organic matter 
     82      CALL p4z_fechem  ( kt, knt, Kbb, Kmm, Krhs )     ! Iron chemistry/scavenging 
    8383      ! 
    8484      IF( ln_p4z ) THEN 
    85          CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
    86          CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    87          !                             ! (for each element : C, Si, Fe, Chl ) 
    88          CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    89          !                             ! zooplankton sources/sinks routines  
    90          CALL p4z_micro( kt, knt )           ! microzooplankton 
    91          CALL p4z_meso ( kt, knt )           ! mesozooplankton 
     85         CALL p4z_lim  ( kt, knt, Kbb, Kmm      )     ! co-limitations by the various nutrients 
     86         CALL p4z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean.  
     87         !                                          ! (for each element : C, Si, Fe, Chl ) 
     88         CALL p4z_mort ( kt,      Kbb,      Krhs )     ! phytoplankton mortality 
     89         !                                          ! zooplankton sources/sinks routines  
     90         CALL p4z_micro( kt, knt, Kbb,      Krhs )     ! microzooplankton 
     91         CALL p4z_meso ( kt, knt, Kbb,      Krhs )     ! mesozooplankton 
    9292      ELSE 
    93          CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
    94          CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    95          !                             ! (for each element : C, Si, Fe, Chl ) 
    96          CALL p5z_mort ( kt      )     ! phytoplankton mortality 
    97          !                             ! zooplankton sources/sinks routines  
    98          CALL p5z_micro( kt, knt )           ! microzooplankton 
    99          CALL p5z_meso ( kt, knt )           ! mesozooplankton 
     93         CALL p5z_lim  ( kt, knt, Kbb, Kmm      )     ! co-limitations by the various nutrients 
     94         CALL p5z_prod ( kt, knt, Kbb, Kmm, Krhs )     ! phytoplankton growth rate over the global ocean.  
     95         !                                          ! (for each element : C, Si, Fe, Chl ) 
     96         CALL p5z_mort ( kt,      Kbb,      Krhs      )     ! phytoplankton mortality 
     97         !                                          ! zooplankton sources/sinks routines  
     98         CALL p5z_micro( kt, knt, Kbb,      Krhs )           ! microzooplankton 
     99         CALL p5z_meso ( kt, knt, Kbb,      Krhs )           ! mesozooplankton 
    100100      ENDIF 
    101101      ! 
    102       CALL p4z_agg     ( kt, knt )     ! Aggregation of particles 
    103       CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
    104       CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles 
     102      CALL p4z_agg     ( kt, knt, Kbb,      Krhs )     ! Aggregation of particles 
     103      CALL p4z_rem     ( kt, knt, Kbb, Kmm, Krhs )     ! remineralization terms of organic matter+scavenging of Fe 
     104      CALL p4z_poc     ( kt, knt, Kbb, Kmm, Krhs )     ! Remineralization of organic particles 
    105105      ! 
    106106      IF( ln_ligand )  & 
    107       & CALL p4z_ligand( kt, knt ) 
     107      & CALL p4z_ligand( kt, knt, Kbb,      Krhs ) 
    108108      !                                                             ! 
    109109      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    110110         WRITE(charout, FMT="('bio ')") 
    111111         CALL prt_ctl_trc_info(charout) 
    112          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     112         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    113113      ENDIF 
    114114      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zche.F90

    r10425 r10975  
    137137CONTAINS 
    138138 
    139    SUBROUTINE p4z_che 
     139   SUBROUTINE p4z_che( Kbb, Kmm ) 
    140140      !!--------------------------------------------------------------------- 
    141141      !!                     ***  ROUTINE p4z_che  *** 
    … …  
    145145      !! ** Method  : - ... 
    146146      !!--------------------------------------------------------------------- 
     147      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    147148      INTEGER  ::   ji, jj, jk 
    148149      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
    … …  
    164165      ! ------------------------------------------------------------- 
    165166      IF (neos == -1) THEN 
    166          salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     167         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 
    167168      ELSE 
    168          salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     169         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    169170      ENDIF 
    170171 
    … …  
    178179         DO jj = 1, jpj 
    179180            DO ji = 1, jpi 
    180                zpres = gdept_n(ji,jj,jk) / 1000. 
    181                za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    182                za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 
    183                tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 
     181               zpres = gdept(ji,jj,jk,Kmm) / 1000. 
     182               za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
     183               za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 
     184               tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 
    184185            END DO 
    185186         END DO 
    … …  
    245246               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    246247               zc1 = 5.92E-3 + zplat**2 * 5.25E-3 
    247                zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept_n(ji,jj,jk)))) / 4.42E-6 
     248               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
    248249               zpres = zpres / 10.0 
    249250 
    … …  
    448449   END SUBROUTINE p4z_che 
    449450 
    450    SUBROUTINE ahini_for_at(p_hini) 
     451   SUBROUTINE ahini_for_at(p_hini, Kbb ) 
    451452      !!--------------------------------------------------------------------- 
    452453      !!                     ***  ROUTINE ahini_for_at  *** 
    … …  
    462463      !!--------------------------------------------------------------------- 
    463464      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     465      INTEGER,                          INTENT(in)   ::  Kbb      ! time level indices 
    464466      INTEGER  ::   ji, jj, jk 
    465467      REAL(wp)  ::  zca1, zba1 
    … …  
    474476        DO jj = 1, jpj 
    475477          DO ji = 1, jpi 
    476             p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    477             p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     478            p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     479            p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    478480            p_bortot = borat(ji,jj,jk) 
    479481            IF (p_alkcb <= 0.) THEN 
    … …  
    516518   !=============================================================================== 
    517519 
    518    SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     520   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 
    519521 
    520522   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
    … …  
    525527   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
    526528   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
    527  
    528    p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
     529   INTEGER,                          INTENT(in)  ::  Kbb      ! time level indices 
     530 
     531   p_alknw_inf(:,:,:) =  -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
    529532   &              - fluorid(:,:,:) 
    530    p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     533   p_alknw_sup(:,:,:) =   (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) )    & 
    531534   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
    532535 
    … …  
    534537 
    535538 
    536    SUBROUTINE solve_at_general( p_hini, zhi ) 
     539   SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 
    537540 
    538541   ! Universal pH solver that converges from any given initial value, 
    … …  
    543546   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
    544547   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     548   INTEGER,                          INTENT(in)   :: Kbb  ! time level indices 
    545549 
    546550   ! Local variables 
    … …  
    565569   IF( ln_timing )  CALL timing_start('solve_at_general') 
    566570 
    567    CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     571   CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 
    568572 
    569573   rmask(:,:,:) = tmask(:,:,:) 
    … …  
    575579         DO ji = 1, jpi 
    576580            IF (rmask(ji,jj,jk) == 1.) THEN 
    577                p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     581               p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    578582               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    579583               zh_ini = p_hini(ji,jj,jk) 
    … …  
    609613            IF (rmask(ji,jj,jk) == 1.) THEN 
    610614               zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    611                p_alktot = trb(ji,jj,jk,jptal) / zfact 
    612                zdic  = trb(ji,jj,jk,jpdic) / zfact 
     615               p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
     616               zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
    613617               zbot  = borat(ji,jj,jk) 
    614                zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 
    615                zsit = trb(ji,jj,jk,jpsil) / zfact 
     618               zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
     619               zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
    616620               zst = sulfat (ji,jj,jk) 
    617621               zft = fluorid(ji,jj,jk) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zfechem.F90

    r10416 r10975  
    3838CONTAINS 
    3939 
    40    SUBROUTINE p4z_fechem( kt, knt ) 
     40   SUBROUTINE p4z_fechem( kt, knt, Kbb, Kmm, Krhs ) 
    4141      !!--------------------------------------------------------------------- 
    4242      !!                     ***  ROUTINE p4z_fechem  *** 
    … …  
    4848      !!--------------------------------------------------------------------- 
    4949      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     50      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5051      ! 
    5152      INTEGER  ::   ji, jj, jk, jic, jn 
    … …  
    7980      ! ------------------------------------------------- 
    8081      IF( ln_ligvar ) THEN 
    81          ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 
     82         ztotlig(:,:,:) =  0.09 * tr(:,:,:,jpdoc,Kbb) * 1E6 + ligand * 1E9 
    8283         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
    8384      ELSE 
    84         IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 
     85        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9 
    8586        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9 
    8687        ENDIF 
    … …  
    9899               zkeq            = fekeq(ji,jj,jk) 
    99100               zfesatur        = zTL1(ji,jj,jk) * 1E-9 
    100                ztfe            = trb(ji,jj,jk,jpfer)  
     101               ztfe            = tr(ji,jj,jk,jpfer,Kbb)  
    101102               ! Fe' is the root of a 2nd order polynom 
    102103               zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
    … …  
    104105                  &              + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
    105106               zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
    106                zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
     107               zFeL1(ji,jj,jk) = MAX( 0., tr(ji,jj,jk,jpfer,Kbb) * 1E9 - zFe3(ji,jj,jk) ) 
    107108           END DO 
    108109         END DO 
    … …  
    132133               precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 
    133134               ! 
    134                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
     135               ztrc   = ( tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + tr(ji,jj,jk,jpcal,Kbb) + tr(ji,jj,jk,jpgsi,Kbb) ) * 1.e6  
    135136               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) & 
    136                &  * EXP( -gdept_n(ji,jj,jk) / 540. ) 
     137               &  * EXP( -gdept(ji,jj,jk,Kmm) / 540. ) 
    137138               IF (ln_ligand) THEN 
    138                   zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * trb(ji,jj,jk,jpoxy) / 100.E-6 ) )) 
     139                  zxlam  = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * tr(ji,jj,jk,jpoxy,Kbb) / 100.E-6 ) )) 
    139140               ELSE 
    140141                  zxlam  = xlam1 * 1.0 
    … …  
    146147               ! to later allocate scavenged iron to the different organic pools 
    147148               ! --------------------------------------------------------- 
    148                zdenom1 = zxlam * trb(ji,jj,jk,jppoc) / zlam1b 
    149                zdenom2 = zxlam * trb(ji,jj,jk,jpgoc) / zlam1b 
     149               zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 
     150               zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 
    150151 
    151152               !  Increased scavenging for very high iron concentrations found near the coasts  
    … …  
    154155               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    155156               zlamfac = MIN( 1.  , zlamfac ) 
    156                zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    157                zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
     157               zdep    = MIN( 1., 1000. / gdept(ji,jj,jk,Kmm) ) 
     158               zcoag   = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr(ji,jj,jk,jpfer,Kbb) 
    158159 
    159160               !  Compute the coagulation of colloidal iron. This parameterization  
    … …  
    161162               !  It requires certainly some more work as it is very poorly constrained. 
    162163               !  ---------------------------------------------------------------- 
    163                zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    164                    &      + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     164               zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     165                   &      + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
    165166               zaggdfea = zlam1a * xstep * zfecoll 
    166167               ! 
    167                zlam1b   = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
     168               zlam1b   = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
    168169               zaggdfeb = zlam1b * xstep * zfecoll 
    169170               ! 
    170                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
     171               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zscave - zaggdfea - zaggdfeb & 
    171172               &                     - zcoag - precip(ji,jj,jk) 
    172                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
    173                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
     173               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zscave * zdenom1 + zaggdfea 
     174               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zscave * zdenom2 + zaggdfeb 
    174175               zscav3d(ji,jj,jk)   = zscave 
    175176               zcoll3d(ji,jj,jk)   = zaggdfea + zaggdfeb 
    … …  
    181182      !  Define the bioavailable fraction of iron 
    182183      !  ---------------------------------------- 
    183       biron(:,:,:) = trb(:,:,:,jpfer)  
     184      biron(:,:,:) = tr(:,:,:,jpfer,Kbb)  
    184185      ! 
    185186      IF( ln_ligand ) THEN 
    … …  
    188189            DO jj = 1, jpj 
    189190               DO ji = 1, jpi 
    190                   zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    191                       &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     191                  zlam1a   = ( 0.369  * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4  * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk)    & 
     192                      &    + ( 114.   * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) 
    192193                  ! 
    193                   zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    194                   zligco   = 0.5 * trn(ji,jj,jk,jplgw) 
     194                  zlam1b   = 3.53E3 *   tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 
     195                  zligco   = 0.5 * tr(ji,jj,jk,jplgw,Kmm) 
    195196                  zaggliga = zlam1a * xstep * zligco 
    196197                  zaggligb = zlam1b * xstep * zligco 
    197                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
     198                  tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 
    198199                  zlcoll3d(ji,jj,jk)  = zaggliga + zaggligb 
    199200               END DO 
    … …  
    201202         END DO 
    202203         ! 
    203          plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
     204         plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) 
    204205         ! 
    205206      ENDIF 
    … …  
    223224         WRITE(charout, FMT="('fechem')") 
    224225         CALL prt_ctl_trc_info(charout) 
    225          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     226         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    226227      ENDIF 
    227228      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zflx.F90

    r10425 r10975  
    5959CONTAINS 
    6060 
    61    SUBROUTINE p4z_flx ( kt, knt ) 
     61   SUBROUTINE p4z_flx ( kt, knt, Kbb, Kmm, Krhs ) 
    6262      !!--------------------------------------------------------------------- 
    6363      !!                     ***  ROUTINE p4z_flx  *** 
    … …  
    7171      !!--------------------------------------------------------------------- 
    7272      INTEGER, INTENT(in) ::   kt, knt   ! 
     73      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs      ! time level indices 
    7374      ! 
    7475      INTEGER  ::   ji, jj, jm, iind, iindm1 
    … …  
    111112            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    112113            zfact = rhop(ji,jj,1) / 1000. + rtrn 
    113             zdic  = trb(ji,jj,1,jpdic) 
     114            zdic  = tr(ji,jj,1,jpdic,Kbb) 
    114115            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    115116            ! CALCULATE [H2CO3] 
    … …  
    127128      DO jj = 1, jpj 
    128129         DO ji = 1, jpi 
    129             ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 
     130            ztc  = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 
    130131            ztc2 = ztc * ztc 
    131132            ztc3 = ztc * ztc2  
    … …  
    162163            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    163164            ! compute the trend 
    164             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) * tmask(ji,jj,1) 
     165            tr(ji,jj,1,jpdic,Krhs) = tr(ji,jj,1,jpdic,Krhs) + ( zfld - zflu ) * rfact2 / e3t(ji,jj,1,Kmm) * tmask(ji,jj,1) 
    165166 
    166167            ! Compute O2 flux  
    167168            zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    168             zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj) 
     169            zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 
    169170            zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 
    170             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 
     171            tr(ji,jj,1,jpoxy,Krhs) = tr(ji,jj,1,jpoxy,Krhs) + zoflx(ji,jj) * rfact2 / e3t(ji,jj,1,Kmm) 
    171172         END DO 
    172173      END DO 
    … …  
    182183         WRITE(charout, FMT="('flx ')") 
    183184         CALL prt_ctl_trc_info(charout) 
    184          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     185         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    185186      ENDIF 
    186187 
    … …  
    204205         ENDIF 
    205206         IF( iom_use( "Dpo2" ) )  THEN 
    206            zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
     207           zw2d(:,:) = ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    207208           CALL iom_put( "Dpo2"  , zw2d ) 
    208209         ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zint.F90

    r10068 r10975  
    2626CONTAINS 
    2727 
    28    SUBROUTINE p4z_int( kt ) 
     28   SUBROUTINE p4z_int( kt, Kbb, Kmm ) 
    2929      !!--------------------------------------------------------------------- 
    3030      !!                     ***  ROUTINE p4z_int  *** 
    … …  
    3333      !! 
    3434      !!--------------------------------------------------------------------- 
    35       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     35      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
     36      INTEGER, INTENT( in ) ::   Kbb, Kmm ! time level indices 
    3637      ! 
    3738      INTEGER  :: ji, jj                 ! dummy loop indices 
    … …  
    4344      ! Computation of phyto and zoo metabolic rate 
    4445      ! ------------------------------------------- 
    45       tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
    46       tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
     46      tgfunc (:,:,:) = EXP( 0.063913 * ts(:,:,:,jp_tem,Kmm) ) 
     47      tgfunc2(:,:,:) = EXP( 0.07608  * ts(:,:,:,jp_tem,Kmm) ) 
    4748 
    4849      ! Computation of the silicon dependant half saturation  constant for silica uptake 
    … …  
    5051      DO ji = 1, jpi 
    5152         DO jj = 1, jpj 
    52             zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil) 
     53            zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 
    5354            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    5455         END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zligand.F90

    r10416 r10975  
    3333CONTAINS 
    3434 
    35    SUBROUTINE p4z_ligand( kt, knt ) 
     35   SUBROUTINE p4z_ligand( kt, knt, Kbb, Krhs ) 
    3636      !!--------------------------------------------------------------------- 
    3737      !!                     ***  ROUTINE p4z_ligand  *** 
    … …  
    3939      !! ** Purpose :   Compute remineralization/scavenging of organic ligands 
    4040      !!--------------------------------------------------------------------- 
    41       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     41      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     42      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices 
    4243      ! 
    4344      INTEGER  ::   ji, jj, jk 
    … …  
    6263               ! This is based on the idea that as LGW is lower 
    6364               ! there is a larger fraction of refractory OM 
    64                zlgwr = max( rlgs , rlgw * exp( -2 * (trb(ji,jj,jk,jplgw)*1e9) ) ) ! years 
    65                zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw) 
     65               zlgwr = max( rlgs , rlgw * exp( -2 * (tr(ji,jj,jk,jplgw,Kbb)*1e9) ) ) ! years 
     66               zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) 
    6667               ! photochem loss of weak ligand 
    67                zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 
    68                tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 
     68               zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr(ji,jj,jk,jplgw,Kbb) * (1. - fr_i(ji,jj)) 
     69               tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zlgwp - zlgwr - zlgwpr 
    6970               zligrem(ji,jj,jk)   = zlgwr 
    7071               zligpr(ji,jj,jk)    = zlgwpr 
    … …  
    9798         WRITE(charout, FMT="('ligand1')") 
    9899         CALL prt_ctl_trc_info(charout) 
    99          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     100         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    100101      ENDIF 
    101102      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zlim.F90

    r10425 r10975  
    7474CONTAINS 
    7575 
    76    SUBROUTINE p4z_lim( kt, knt ) 
     76   SUBROUTINE p4z_lim( kt, knt, Kbb, Kmm ) 
    7777      !!--------------------------------------------------------------------- 
    7878      !!                     ***  ROUTINE p4z_lim  *** 
    … …  
    8484      !!--------------------------------------------------------------------- 
    8585      INTEGER, INTENT(in)  :: kt, knt 
     86      INTEGER, INTENT(in)  :: Kbb, Kmm      ! time level indices 
    8687      ! 
    8788      INTEGER  ::   ji, jj, jk 
    … …  
    101102               ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    102103               !------------------------------------- 
    103                zno3    = trb(ji,jj,jk,jpno3) / 40.e-6 
     104               zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 
    104105               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
    105106               zferlim = MIN( zferlim, 7e-11 ) 
    106                trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 
     107               tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 
    107108 
    108109               ! Computation of a variable Ks for iron on diatoms taking into account 
    109110               ! that increasing biomass is made of generally bigger cells 
    110111               !------------------------------------------------ 
    111                zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    112                zconcd2  = trb(ji,jj,jk,jpdia) - zconcd 
    113                zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy ) 
    114                zconcn2  = trb(ji,jj,jk,jpphy) - zconcn 
    115                z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    116                z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     112               zconcd   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     113               zconcd2  = tr(ji,jj,jk,jpdia,Kbb) - zconcd 
     114               zconcn   = MAX( 0.e0 , tr(ji,jj,jk,jpphy,Kbb) - xsizephy ) 
     115               zconcn2  = tr(ji,jj,jk,jpphy,Kbb) - zconcn 
     116               z1_trbphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     117               z1_trbdia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
    117118 
    118119               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 
    … …  
    126127               ! Michaelis-Menten Limitation term for nutrients Small bacteria 
    127128               ! ------------------------------------------------------------- 
    128                zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) ) 
    129                xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom 
    130                xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom 
     129               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * tr(ji,jj,jk,jpno3,Kbb) + concbno3 * tr(ji,jj,jk,jpnh4,Kbb) ) 
     130               xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * concbnh4 * zdenom 
     131               xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * concbno3 * zdenom 
    131132               ! 
    132133               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    133                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 ) 
    134                zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) ) 
    135                zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) ) 
     134               zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbnh4 ) 
     135               zlim3    = tr(ji,jj,jk,jpfer,Kbb) / ( concbfe + tr(ji,jj,jk,jpfer,Kbb) ) 
     136               zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) ) 
    136137               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    137138               xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
    … …  
    139140               ! Michaelis-Menten Limitation term for nutrients Small flagellates 
    140141               ! ----------------------------------------------- 
    141                zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) ) 
    142                xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
    143                xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
     142               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc0n * tr(ji,jj,jk,jpnh4,Kbb) ) 
     143               xnanono3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc0nnh4 * zdenom 
     144               xnanonh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc0n    * zdenom 
    144145               ! 
    145146               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    146                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 ) 
    147                zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy  
    148                zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     147               zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc0nnh4 ) 
     148               zratio   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trbphy  
     149               zironmin = xcoef1 * tr(ji,jj,jk,jpnch,Kbb) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
    149150               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
    150151               xnanopo4(ji,jj,jk) = zlim2 
    … …  
    154155               !   Michaelis-Menten Limitation term for nutrients Diatoms 
    155156               !   ---------------------------------------------- 
    156                zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) ) 
    157                xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
    158                xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
     157               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr(ji,jj,jk,jpno3,Kbb) + zconc1d * tr(ji,jj,jk,jpnh4,Kbb) ) 
     158               xdiatno3(ji,jj,jk) = tr(ji,jj,jk,jpno3,Kbb) * zconc1dnh4 * zdenom 
     159               xdiatnh4(ji,jj,jk) = tr(ji,jj,jk,jpnh4,Kbb) * zconc1d    * zdenom 
    159160               ! 
    160161               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    161                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  ) 
    162                zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
    163                zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia 
    164                zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     162               zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zconc1dnh4  ) 
     163               zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
     164               zratio   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 
     165               zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
    165166               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
    166167               xdiatpo4(ji,jj,jk) = zlim2 
    … …  
    177178         DO jj = 1, jpj 
    178179            DO ji = 1, jpi 
    179                zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    & 
    180                   &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) )  
    181                zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 ) 
    182                zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   ) 
    183                ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    184                ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
     180               zlim1 =  ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 )    & 
     181                  &   / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) )  
     182               zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnnh4 ) 
     183               zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11   ) 
     184               ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 
     185               ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10. 
    185186               zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )  
    186187               zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )  
    … …  
    188189               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
    189190                  &                       * ztem1 / ( 0.1 + ztem1 )                     & 
    190                   &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
     191                  &                       * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. )  & 
    191192                  &                       * zetot1 * zetot2               & 
    192193                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
    … …  
    202203            DO ji = 1, jpi 
    203204               ! denitrification factor computed from O2 levels 
    204                nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    & 
    205                   &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  ) 
     205               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 
     206                  &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  ) 
    206207               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
    207208               ! 
    208209               ! denitrification factor computed from NO3 levels 
    209                nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - trb(ji,jj,jk,jpno3) )  & 
    210                   &                                / ( 1.E-6 + trb(ji,jj,jk,jpno3) ) ) 
     210               nitrfac2(ji,jj,jk) = MAX( 0.e0,       ( 1.E-6 - tr(ji,jj,jk,jpno3,Kbb) )  & 
     211                  &                                / ( 1.E-6 + tr(ji,jj,jk,jpno3,Kbb) ) ) 
    211212               nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 
    212213            END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zlys.F90

    r10069 r10975  
    4343CONTAINS 
    4444 
    45    SUBROUTINE p4z_lys( kt, knt ) 
     45   SUBROUTINE p4z_lys( kt, knt, Kbb, Krhs ) 
    4646      !!--------------------------------------------------------------------- 
    4747      !!                     ***  ROUTINE p4z_lys  *** 
    … …  
    5454      !!--------------------------------------------------------------------- 
    5555      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     56      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices 
    5657      ! 
    5758      INTEGER  ::   ji, jj, jk, jn 
    … …  
    7273      !     ------------------------------------------- 
    7374 
    74       CALL solve_at_general( zhinit, zhi ) 
     75      CALL solve_at_general( zhinit, zhi, Kbb ) 
    7576 
    7677      DO jk = 1, jpkm1 
    7778         DO jj = 1, jpj 
    7879            DO ji = 1, jpi 
    79                zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
     80               zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
    8081                  &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
    8182               hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
    … …  
    109110               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    110111               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    111                zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 
     112               zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb) 
    112113              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    113114              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    114115              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
    115116              ! 
    116               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
    117               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
    118               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
     117              tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk) 
     118              tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) -      zcaldiss(ji,jj,jk) 
     119              tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) +      zcaldiss(ji,jj,jk) 
    119120            END DO 
    120121         END DO 
    … …  
    132133        WRITE(charout, FMT="('lys ')") 
    133134        CALL prt_ctl_trc_info(charout) 
    134         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     135        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    135136      ENDIF 
    136137      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zmeso.F90

    r10367 r10975  
    5151CONTAINS 
    5252 
    53    SUBROUTINE p4z_meso( kt, knt ) 
     53   SUBROUTINE p4z_meso( kt, knt, Kbb, Krhs ) 
    5454      !!--------------------------------------------------------------------- 
    5555      !!                     ***  ROUTINE p4z_meso  *** 
    … …  
    6060      !!--------------------------------------------------------------------- 
    6161      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     62      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices 
    6263      ! 
    6364      INTEGER  :: ji, jj, jk 
    … …  
    8990         DO jj = 1, jpj 
    9091            DO ji = 1, jpi 
    91                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     92               zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
    9293               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    9394 
    9495               !  Respiration rates of both zooplankton 
    9596               !  ------------------------------------- 
    96                zrespz    = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
     97               zrespz    = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
    9798               &           + 3. * nitrfac(ji,jj,jk) ) 
    9899 
    … …  
    100101               !  no real reason except that it seems to be more stable and may mimic predation 
    101102               !  --------------------------------------------------------------- 
    102                ztortz    = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)  * (1. - nitrfac(ji,jj,jk) ) 
    103                ! 
    104                zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    105                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    106                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
     103               ztortz    = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb)  * (1. - nitrfac(ji,jj,jk) ) 
     104               ! 
     105               zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
     106               zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
     107               zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
    107108               ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
    108109               ! it is to predation by mesozooplankton 
    109110               ! ------------------------------------------------------------------------------- 
    110                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 
     111               zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 
    111112                  &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
    112113 
    … …  
    117118               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    118119               zdenom2   = zdenom / ( zfood + rtrn ) 
    119                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
     120               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
    120121 
    121122               zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
    … …  
    124125               zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2  
    125126 
    126                zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    127                zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    128                zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
     127               zgraznf   = zgrazn   * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     128               zgrazf    = zgrazd   * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     129               zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    129130 
    130131               !  Mesozooplankton flux feeding on GOC 
    131132               !  ---------------------------------- 
    132133               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    133                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 
     134               &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
    134135               &           * (1. - nitrfac(ji,jj,jk)) 
    135                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
     136               zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
    136137               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    137                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) & 
     138               &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 
    138139               &           * (1. - nitrfac(ji,jj,jk)) 
    139                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
     140               zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    140141               ! 
    141142               zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    … …  
    145146               ! diatoms based aggregates are more prone to fractionation 
    146147               ! since they are more porous (marine snow instead of fecal pellets) 
    147                zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
     148               zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
    148149               zratio2   = zratio * zratio 
    149150               zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    150                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
     151               &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
    151152               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    152                zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
     153               zfracfe   = zfrac * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
    153154 
    154155               zgrazffep = zproport * zgrazffep 
    … …  
    181182               !   Update the arrays TRA which contain the biological sources and sinks 
    182183               zgrarsig  = zgrarem2 * sigma2 
    183                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    184                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    185                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     184               tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     185               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     186               tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem2 - zgrarsig 
    186187               ! 
    187188               IF( ln_ligand ) THEN  
    188                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 
     189                  tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 
    189190                  zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
    190191               ENDIF 
    191192               ! 
    192                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    193                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     193               tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     194               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer2 
    194195               zfezoo2(ji,jj,jk)   = zgrafer2 
    195                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    196                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
     196               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     197               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig               
    197198 
    198199               zmortz = ztortz + zrespz 
    199200               zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
    200                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc  
    201                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    202                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    203                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 
    204                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    205                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    206                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    207                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    208                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    209                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    210  
    211                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 
     201               tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) - zmortz + zepsherv * zgraztotc  
     202               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazd 
     203               tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
     204               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazn 
     205               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazn * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     206               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazd * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     207               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     208               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazd * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     209               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     210               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazf 
     211 
     212               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfrac 
    212213               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
    213214               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    214                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
     215               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
    215216               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
    216217               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    217                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    218                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     & 
     218               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
     219               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ferat3 * zmortzgoc - zgrazfffg     & 
    219220                 &                + zgraztotf * unass2 - zfracfe 
    220                zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
     221               zfracal = tr(ji,jj,jk,jpcal,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
    221222               zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
    222223               ! calcite production 
    … …  
    225226               ! 
    226227               zprcaca = part2 * zprcaca 
    227                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
    228                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
    229                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
     228               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
     229               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * ( zgrazcal + zprcaca ) 
     230               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
    230231            END DO 
    231232         END DO 
    … …  
    258259        WRITE(charout, FMT="('meso')") 
    259260        CALL prt_ctl_trc_info(charout) 
    260         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     261        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    261262      ENDIF 
    262263      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zmicro.F90

    r10374 r10975  
    4949CONTAINS 
    5050 
    51    SUBROUTINE p4z_micro( kt, knt ) 
     51   SUBROUTINE p4z_micro( kt, knt, Kbb, Krhs ) 
    5252      !!--------------------------------------------------------------------- 
    5353      !!                     ***  ROUTINE p4z_micro  *** 
    … …  
    5959      INTEGER, INTENT(in) ::   kt    ! ocean time step 
    6060      INTEGER, INTENT(in) ::   knt   ! ???  
     61      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    6162      ! 
    6263      INTEGER  :: ji, jj, jk 
    … …  
    8485         DO jj = 1, jpj 
    8586            DO ji = 1, jpi 
    86                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     87               zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
    8788               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    8889 
    8990               !  Respiration rates of both zooplankton 
    9091               !  ------------------------------------- 
    91                zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
     92               zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
    9293                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    9394 
    … …  
    9596               !  no real reason except that it seems to be more stable and may mimic predation. 
    9697               !  --------------------------------------------------------------- 
    97                ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
    98  
    99                zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    100                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    101                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
     98               ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
     99 
     100               zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
     101               zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
     102               zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
    102103                
    103104               !     Microzooplankton grazing 
    … …  
    107108               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    108109               zdenom2   = zdenom / ( zfood + rtrn ) 
    109                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
     110               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
    110111 
    111112               zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2  
    … …  
    113114               zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2  
    114115 
    115                zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
    116                zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    117                zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
     116               zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     117               zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     118               zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
    118119               ! 
    119120               zgraztotc = zgrazp  + zgrazm  + zgrazsd  
    … …  
    140141               !  ------------------------ 
    141142               zgrarsig  = zgrarem * sigma1 
    142                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    143                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    144                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     143               tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig 
     144               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig 
     145               tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig 
    145146               ! 
    146147               IF( ln_ligand ) THEN 
    147                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 
     148                  tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 
    148149                  zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 
    149150               ENDIF 
    150151               ! 
    151                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    152                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
     152               tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig 
     153               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer 
    153154               zfezoo(ji,jj,jk)    = zgrafer 
    154                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     155               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 
    155156               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc 
    156                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
    157                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    158                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
     157               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass 
     158               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig 
     159               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig 
    159160               !   Update the arrays TRA which contain the biological sources and sinks 
    160161               !   -------------------------------------------------------------------- 
    161162               zmortz = ztortz + zrespz 
    162                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztotc  
    163                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    164                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
    165                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    166                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
    167                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    168                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    169                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 
    170                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
     163               tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc  
     164               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp 
     165               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd 
     166               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp  * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     167               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     168               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     169               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     170               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf 
     171               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf 
     172               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm 
    172173               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
    173174               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
    174                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
     175               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 
    175176               ! 
    176177               ! calcite production 
    … …  
    179180               ! 
    180181               zprcaca = part * zprcaca 
    181                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    182                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    183                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
     182               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     183               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     184               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
    184185            END DO 
    185186         END DO 
    … …  
    210211         WRITE(charout, FMT="('micro')") 
    211212         CALL prt_ctl_trc_info(charout) 
    212          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     213         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    213214      ENDIF 
    214215      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zmort.F90

    r10227 r10975  
    3636CONTAINS 
    3737 
    38    SUBROUTINE p4z_mort( kt ) 
     38   SUBROUTINE p4z_mort( kt, Kbb, Krhs ) 
    3939      !!--------------------------------------------------------------------- 
    4040      !!                     ***  ROUTINE p4z_mort  *** 
    … …  
    4646      !!--------------------------------------------------------------------- 
    4747      INTEGER, INTENT(in) ::   kt ! ocean time step 
    48       !!--------------------------------------------------------------------- 
    49       ! 
    50       CALL p4z_nano            ! nanophytoplankton 
    51       ! 
    52       CALL p4z_diat            ! diatoms 
     48      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
     49      !!--------------------------------------------------------------------- 
     50      ! 
     51      CALL p4z_nano( Kbb, Krhs )            ! nanophytoplankton 
     52      ! 
     53      CALL p4z_diat( Kbb, Krhs )            ! diatoms 
    5354      ! 
    5455   END SUBROUTINE p4z_mort 
    5556 
    5657 
    57    SUBROUTINE p4z_nano 
     58   SUBROUTINE p4z_nano( Kbb, Krhs ) 
    5859      !!--------------------------------------------------------------------- 
    5960      !!                     ***  ROUTINE p4z_nano  *** 
    … …  
    6364      !! ** Method  : - ??? 
    6465      !!--------------------------------------------------------------------- 
     66      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    6567      INTEGER  ::   ji, jj, jk 
    6668      REAL(wp) ::   zsizerat, zcompaph 
    … …  
    7678         DO jj = 1, jpj 
    7779            DO ji = 1, jpi 
    78                zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
     80               zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 
    7981               !     When highly limited by macronutrients, very small cells  
    8082               !     dominate the community. As a consequence, aggregation 
    8183               !     due to turbulence is negligible. Mortality is also set 
    8284               !     to 0 
    83                zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy) 
     85               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb) 
    8486               !     Squared mortality of Phyto similar to a sedimentation term during 
    8587               !     blooms (Doney et al. 1996) 
    … …  
    8991               !     increased when nutrients are limiting phytoplankton growth 
    9092               !     as observed for instance in case of iron limitation. 
    91                ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat 
     93               ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat 
    9294 
    9395               zmortp = zrespp + ztortp 
    … …  
    9597               !   Update the arrays TRA which contains the biological sources and sinks 
    9698 
    97                zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 
    98                zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    99                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 
    100                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 
    101                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
     99               zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     100               zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     101               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 
     102               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 
     103               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 
    102104               zprcaca = xfracal(ji,jj,jk) * zmortp 
    103105               ! 
    … …  
    105107               ! 
    106108               zfracal = 0.5 * xfracal(ji,jj,jk) 
    107                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    108                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    109                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    110                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 
    111                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 
     109               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     110               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     111               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     112               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp 
     113               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp 
    112114               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 
    113115               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 
    114                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 
    115                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 
     116               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe 
     117               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe 
    116118            END DO 
    117119         END DO 
    … …  
    121123         WRITE(charout, FMT="('nano')") 
    122124         CALL prt_ctl_trc_info(charout) 
    123          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     125         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    124126       ENDIF 
    125127      ! 
    … …  
    129131 
    130132 
    131    SUBROUTINE p4z_diat 
     133   SUBROUTINE p4z_diat( Kbb, Krhs ) 
    132134      !!--------------------------------------------------------------------- 
    133135      !!                     ***  ROUTINE p4z_diat  *** 
    … …  
    137139      !! ** Method  : - ??? 
    138140      !!--------------------------------------------------------------------- 
     141      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    139142      INTEGER  ::   ji, jj, jk 
    140143      REAL(wp) ::   zfactfe,zfactsi,zfactch, zcompadi 
    … …  
    155158            DO ji = 1, jpi 
    156159 
    157                zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. ) 
     160               zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 
    158161 
    159162               !    Aggregation term for diatoms is increased in case of nutrient 
    … …  
    165168               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    166169               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    167                zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
     170               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
    168171 
    169172               !     Phytoplankton mortality.  
    170173               !     ------------------------ 
    171                ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
     174               ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi  
    172175 
    173176               zmortp2 = zrespp2 + ztortp2 
    174177 
    175                !   Update the arrays tra which contains the biological sources and sinks 
     178               !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
    176179               !   --------------------------------------------------------------------- 
    177                zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    178                zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    179                zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    180                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2  
    181                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 
    182                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 
    183                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 
    184                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 
    185                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 
    186                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 
     180               zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     181               zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     182               zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     183               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
     184               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
     185               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
     186               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
     187               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
     188               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2 
     189               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2 
    187190               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
    188191               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
    189                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 
    190                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
     192               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe 
     193               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
    191194            END DO 
    192195         END DO 
    … …  
    196199         WRITE(charout, FMT="('diat')") 
    197200         CALL prt_ctl_trc_info(charout) 
    198          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     201         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    199202      ENDIF 
    200203      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zopt.F90

    r10522 r10975  
    4949CONTAINS 
    5050 
    51    SUBROUTINE p4z_opt( kt, knt ) 
     51   SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm ) 
    5252      !!--------------------------------------------------------------------- 
    5353      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    5959      !!--------------------------------------------------------------------- 
    6060      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
     61      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    6162      ! 
    6263      INTEGER  ::   ji, jj, jk 
    … …  
    8384      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    8485      !                                        !  -------------------------------------------------------- 
    85                      zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
    86       IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + trb(:,:,:,jppch) 
     86                     zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb) 
     87      IF( ln_p5z )   zchl3d(:,:,:) = zchl3d(:,:,:)    + tr(:,:,:,jppch,Kbb) 
    8788      ! 
    8889      DO jk = 1, jpkm1    
    … …  
    9394               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    9495               !                                                          
    95                ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk) 
    96                ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk) 
    97                ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk) 
     96               ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 
     97               ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 
     98               ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 
    9899            END DO 
    99100         END DO 
    … …  
    105106         zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    106107         ! 
    107          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
     108         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    108109         ! 
    109110         DO jk = 1, nksrp       
    … …  
    120121         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    121122         ! 
    122          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
     123         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 )  
    123124         ! 
    124125         DO jk = 1, nksrp       
    … …  
    130131         zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 
    131132         ! 
    132          CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
     133         CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    133134         ! 
    134135         DO jk = 1, nksrp       
    … …  
    148149      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
    149150         !                                     !  ------------------------ 
    150          CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
     151         CALL p4z_opt_par( kt, Kmm, qsr, ze1, ze2, ze3, pe0=ze0 ) 
    151152         ! 
    152153         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
    … …  
    158159      !                                        !* Euphotic depth and level 
    159160      neln   (:,:) = 1                            !  ------------------------ 
    160       heup   (:,:) = gdepw_n(:,:,2) 
    161       heup_01(:,:) = gdepw_n(:,:,2) 
     161      heup   (:,:) = gdepw(:,:,2,Kmm) 
     162      heup_01(:,:) = gdepw(:,:,2,Kmm) 
    162163 
    163164      DO jk = 2, nksrp 
    … …  
    167168                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    168169                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    169                  heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
     170                 heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm)     ! Euphotic layer depth 
    170171              ENDIF 
    171172              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
    172                  heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition) 
     173                 heup_01(ji,jj) = gdepw(ji,jj,jk+1,Kmm)  ! Euphotic layer depth (light level definition) 
    173174              ENDIF 
    174175           END DO 
    … …  
    186187         DO jj = 1, jpj 
    187188            DO ji = 1, jpi 
    188                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    189                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t_n(ji,jj,jk) ! remineralisation 
    190                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    191                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
     189               IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
     190                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation 
     191                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     192                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
    192193               ENDIF 
    193194            END DO 
    … …  
    201202         DO jj = 1, jpj 
    202203            DO ji = 1, jpi 
    203                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     204               IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    204205                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    205206                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
    … …  
    217218         DO jj = 1, jpj 
    218219            DO ji = 1, jpi 
    219                IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    220                   zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    221                   zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
    222                   zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t_n(ji,jj,jk) 
     220               IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     221                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     222                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
     223                  zdepmoy(ji,jj) = zdepmoy(ji,jj) +                       e3t(ji,jj,jk,Kmm) 
    223224               ENDIF 
    224225            END DO 
    … …  
    231232         DO jj = 1, jpj 
    232233            DO ji = 1, jpi 
    233                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     234               IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    234235                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    235236                  enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
    … …  
    245246            DO jj = 1, jpj 
    246247               DO ji = 1, jpi 
    247                   IF( gdepw_n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
    248                      zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     248                  IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 
     249                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production 
    249250                  ENDIF 
    250251               END DO 
    … …  
    257258            DO jj = 1, jpj 
    258259               DO ji = 1, jpi 
    259                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     260                  IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    260261                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    261262                     epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
    … …  
    279280 
    280281 
    281    SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
     282   SUBROUTINE p4z_opt_par( kt, Kmm, pqsr, pe1, pe2, pe3, pe0, pqsr100 )  
    282283      !!---------------------------------------------------------------------- 
    283284      !!                  ***  routine p4z_opt_par  *** 
    … …  
    288289      !!---------------------------------------------------------------------- 
    289290      INTEGER                         , INTENT(in)              ::   kt                ! ocean time-step 
     291      INTEGER                         , INTENT(in)              ::   Kmm               ! ocean time-index 
    290292      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   )           ::   pqsr              ! shortwave 
    291293      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pe1 , pe2 , pe3   ! PAR ( R-G-B) 
    … …  
    315317            DO jj = 1, jpj 
    316318               DO ji = 1, jpi 
    317                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 
     319                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 
    318320                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
    319321                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zpoc.F90

    r10362 r10975  
    4444CONTAINS 
    4545 
    46    SUBROUTINE p4z_poc( kt, knt ) 
     46   SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs ) 
    4747      !!--------------------------------------------------------------------- 
    4848      !!                     ***  ROUTINE p4z_poc  *** 
    … …  
    5252      !! ** Method  : - ??? 
    5353      !!--------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     54      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step and ??? 
     55      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5556      ! 
    5657      INTEGER  ::   ji, jj, jk, jn 
    … …  
    112113                ! ------------------------------------------------------------ 
    113114                ! 
    114                 IF( gdept_n(ji,jj,jk) > zdep ) THEN 
     115                IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
    115116                  alphat = 0. 
    116117                  remint = 0. 
    117118                  ! 
    118                   zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    119                   zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     119                  zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     120                  zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    120121                  ! 
    121                   IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 
     122                  IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
    122123                    !  
    123124                    ! The first level just below the mixed layer needs a  
    … …  
    130131                    ! POC concentration is computed using the lagrangian  
    131132                    ! framework. It is only used for the lability param 
    132                     zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk) * rday / rfact2               & 
    133                     &   * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     133                    zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               & 
     134                    &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    134135                    zpoc = MAX(0., zpoc) 
    135136                    ! 
    … …  
    157158                    ! --------------------------------------------------- 
    158159                    ! 
    159                     zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
    160                     &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
    161                     &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     160                    zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
     161                    &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
     162                    &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    162163                    zpoc = max(0., zpoc) 
    163164                    ! 
    … …  
    197198                  ! -------------------------------------------------------- 
    198199                  zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    199                   zorem2  = zremig * trb(ji,jj,jk,jpgoc) 
     200                  zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb) 
    200201                  orem(ji,jj,jk)      = zorem2 
    201                   zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 
    202                   zofer2 = zremig * trb(ji,jj,jk,jpbfe) 
    203                   zofer3 = zremig * solgoc * trb(ji,jj,jk,jpbfe) 
     202                  zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     203                  zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     204                  zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 
    204205 
    205206                  ! ------------------------------------- 
    206                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 
    207                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk) 
    208                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3 
    209                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3 
    210                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2 
    211                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 
     207                  tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     208                  tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 
     209                  tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 
     210                  tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 
     211                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 
     212                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
    212213                  zfolimi(ji,jj,jk)   = zofer2 
    213214               END DO 
    … …  
    221222                  ! -------------------------------------------------------- 
    222223                  zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    223                   zopoc2 = zremig  * trb(ji,jj,jk,jpgoc) 
     224                  zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb) 
    224225                  orem(ji,jj,jk) = zopoc2 
    225                   zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 
    226                   zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon) 
    227                   zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop) 
    228                   zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe) 
     226                  zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     227                  zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 
     228                  zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 
     229                  zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 
    229230 
    230231                  ! ------------------------------------- 
    231                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 
    232                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2  
    233                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2 
    234                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2 
    235                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2 
    236                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2 
    237                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2 
    238                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 
    239                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk) 
    240                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc) 
    241                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc) 
    242                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 * (1. + solgoc) 
     232                  tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     233                  tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2  
     234                  tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 
     235                  tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 
     236                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 
     237                  tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 
     238                  tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 
     239                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     240                  tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 
     241                  tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 
     242                  tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 
     243                  tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 
    243244                  zfolimi(ji,jj,jk)   = zofer2 
    244245               END DO 
    … …  
    250251        WRITE(charout, FMT="('poc1')") 
    251252        CALL prt_ctl_trc_info(charout) 
    252         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     253        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    253254     ENDIF 
    254255 
    … …  
    271272           DO ji = 1, jpi 
    272273              zdep = hmld(ji,jj) 
    273               IF (tmask(ji,jj,jk) == 1. .AND. gdept_n(ji,jj,jk) <= zdep ) THEN 
    274                 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2 
     274              IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     275                totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 
    275276                ! The temperature effect is included here 
    276                 totthick(ji,jj) = totthick(ji,jj) + e3t_n(ji,jj,jk)* tgfunc(ji,jj,jk) 
    277                 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2    & 
    278                 &                / ( trb(ji,jj,jk,jppoc) + rtrn ) 
     277                totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 
     278                totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    & 
     279                &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
    279280              ENDIF 
    280281           END DO 
    … …  
    292293                alphat = 0.0 
    293294                remint = 0.0 
    294                 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 
     295                IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
    295296                   DO jn = 1, jcpoc 
    296297                      ! For each lability class, the system is supposed to be  
    … …  
    329330              IF (tmask(ji,jj,jk) == 1.) THEN 
    330331                zdep = hmld(ji,jj) 
    331                 IF( gdept_n(ji,jj,jk) > zdep ) THEN 
     332                IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
    332333                  alphat = 0. 
    333334                  remint = 0. 
    334335                  ! 
    335336                  ! the scale factors are corrected with temperature 
    336                   zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    337                   zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     337                  zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     338                  zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    338339                  ! 
    339340                  ! Special treatment of the level just below the MXL 
    … …  
    341342                  ! --------------------------------------------------- 
    342343                  ! 
    343                   IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 
     344                  IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
    344345                    ! 
    345346                    ! Computation of the POC concentration using the  
    346347                    ! lagrangian algorithm 
    347                     zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk) * rday / rfact2               & 
    348                     &   * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     348                    zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               & 
     349                    &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    349350                    zpoc = max(0., zpoc) 
    350351                    !  
    … …  
    366367                    ! -------------------------------------------------------- 
    367368                    ! 
    368                     zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
    369                     &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
    370                     &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     369                    zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
     370                    &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
     371                    &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    371372                    zpoc = max(0., zpoc) 
    372373                    ! 
    … …  
    409410                    ! -------------------------------------------------------- 
    410411                    zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    411                     zorem           = zremip * trb(ji,jj,jk,jppoc) 
    412                     zofer           = zremip * trb(ji,jj,jk,jpsfe) 
    413  
    414                     tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
     412                    zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     413                    zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     414 
     415                    tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 
    415416                    orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
    416                     tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
    417                     tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 
    418                     tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
     417                    tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
     418                    tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 
     419                    tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
    419420                    zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    420421                  ENDIF 
    … …  
    429430                ! -------------------------------------------------------- 
    430431                zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    431                 zopoc  = zremip * trb(ji,jj,jk,jppoc) 
     432                zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb) 
    432433                orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
    433                 zopon  = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon) 
    434                 zopop  = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop) 
    435                 zofer  = xremipn / xremipc * zremip * trb(ji,jj,jk,jpsfe) 
    436  
    437                 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc 
    438                 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon 
    439                 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop 
    440                 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
    441                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc 
    442                 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon  
    443                 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop  
    444                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer  
     434                zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 
     435                zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 
     436                zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     437 
     438                tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 
     439                tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 
     440                tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 
     441                tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     442                tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 
     443                tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon  
     444                tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop  
     445                tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer  
    445446                zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    446447             END DO 
    … …  
    461462         WRITE(charout, FMT="('poc2')") 
    462463         CALL prt_ctl_trc_info(charout) 
    463          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     464         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    464465      ENDIF 
    465466      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zprod.F90

    r10425 r10975  
    5353CONTAINS 
    5454 
    55    SUBROUTINE p4z_prod( kt , knt ) 
     55   SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    5656      !!--------------------------------------------------------------------- 
    5757      !!                     ***  ROUTINE p4z_prod  *** 
    … …  
    6363      !!--------------------------------------------------------------------- 
    6464      INTEGER, INTENT(in) ::   kt, knt   ! 
     65      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    6566      ! 
    6667      INTEGER  ::   ji, jj, jk 
    … …  
    119120               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    120121                  zval = MAX( 1., zstrn(ji,jj) ) 
    121                   IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 
     122                  IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 
    122123                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
    123124                  ENDIF 
    … …  
    140141            DO ji = 1, jpi 
    141142               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    142                   ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     143                  ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
    143144                  zadap       = xadap * ztn / ( 2.+ ztn ) 
    144                   zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    145                   zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
     145                  zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 
     146                  zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 
    146147                  ! 
    147148                  zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
    148                   &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
     149                  &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
    149150                  ! 
    150                   zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
    151                   &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
     151                  zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   & 
     152                  &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
    152153               ENDIF 
    153154            END DO 
    … …  
    204205                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    205206                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    206                   zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
     207                  zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
    207208                  zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    208209                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    209                   zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
     210                  zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
    210211                  IF (gphit(ji,jj) < -30 ) THEN 
    211212                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    … …  
    239240               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    240241                  !  production terms for nanophyto. (C) 
    241                   zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
     242                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    242243                  zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    243244                  ! 
    244                   zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 
     245                  zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn ) 
    245246                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    246247                  zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
    247248                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
    248249                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
    249                   &             * zmax * trb(ji,jj,jk,jpphy) * rfact2 
     250                  &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    250251                  !  production terms for diatoms (C) 
    251                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
     252                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    252253                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    253254                  ! 
    254                   zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 
     255                  zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn ) 
    255256                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    256257                  zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  & 
    257258                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
    258259                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
    259                   &             * zmax * trb(ji,jj,jk,jpdia) * rfact2 
     260                  &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    260261               ENDIF 
    261262            END DO 
    … …  
    272273                  zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
    273274                  zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
    274                   chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
     275                  chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
    275276                  zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
    276277                                        & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
    … …  
    279280                  zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
    280281                  zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
    281                   chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
     282                  chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.)) 
    282283                  zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
    283284                                        & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
    284285                  !   Update the arrays TRA which contain the Chla sources and sinks 
    285                   tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
    286                   tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
     286                  tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     287                  tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
    287288               ENDIF 
    288289            END DO 
    … …  
    298299                 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
    299300                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
    300                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
    301                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
    302                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
    303                  tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 
    304                  tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
    305                  tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 
    306                  tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
    307                  tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    308                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 
    309                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
     301                 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     302                 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
     303                 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2 
     304                 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn 
     305                 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     306                 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd 
     307                 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     308                 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     309                 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod 
     310                 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) & 
    310311                 &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    311312                 ! 
    312313                 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
    313                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
    314                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    315                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
    316                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     314                 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     315                 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     316                 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     317                 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
    317318                 &                                         - rno3 * ( zproreg + zproreg2 ) 
    318319              ENDIF 
    … …  
    328329                    zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
    329330                    zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
    330                     tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     331                    tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
    331332                    zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    332333                    zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
    … …  
    413414             zw2d(:,:) = 0. 
    414415             DO jk = 1, jpkm1 
    415                zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
     416               zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
    416417             ENDDO 
    417418             CALL iom_put( "INTPPPHYN" , zw2d ) 
    … …  
    419420             zw2d(:,:) = 0. 
    420421             DO jk = 1, jpkm1 
    421                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
     422                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
    422423             ENDDO 
    423424             CALL iom_put( "INTPPPHYD" , zw2d ) 
    … …  
    426427             zw2d(:,:) = 0. 
    427428             DO jk = 1, jpkm1 
    428                 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
     429                zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert. integrated pp 
    429430             ENDDO 
    430431             CALL iom_put( "INTPP" , zw2d ) 
    … …  
    433434             zw2d(:,:) = 0. 
    434435             DO jk = 1, jpkm1 
    435                 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
     436                zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
    436437             ENDDO 
    437438             CALL iom_put( "INTPNEW" , zw2d ) 
    … …  
    440441             zw2d(:,:) = 0. 
    441442             DO jk = 1, jpkm1 
    442                 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
     443                zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
    443444             ENDDO 
    444445            CALL iom_put( "INTPBFE" , zw2d ) 
    … …  
    447448             zw2d(:,:) = 0. 
    448449             DO jk = 1, jpkm1 
    449                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
     450                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
    450451             ENDDO 
    451452             CALL iom_put( "INTPBSI" , zw2d ) 
    … …  
    460461         WRITE(charout, FMT="('prod')") 
    461462         CALL prt_ctl_trc_info(charout) 
    462          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     463         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    463464     ENDIF 
    464465      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zrem.F90

    r10425 r10975  
    4949CONTAINS 
    5050 
    51    SUBROUTINE p4z_rem( kt, knt ) 
     51   SUBROUTINE p4z_rem( kt, knt, Kbb, Kmm, Krhs ) 
    5252      !!--------------------------------------------------------------------- 
    5353      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    5757      !! ** Method  : - ??? 
    5858      !!--------------------------------------------------------------------- 
    59       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     59      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step 
     60      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    6061      ! 
    6162      INTEGER  ::   ji, jj, jk 
    … …  
    9091            DO ji = 1, jpi 
    9192               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    92                IF( gdept_n(ji,jj,jk) < zdep ) THEN 
    93                   zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 
     93               IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN 
     94                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr(ji,jj,jk,jpzoo,Kbb) + 2.* tr(ji,jj,jk,jpmes,Kbb) ), 4.e-6 ) 
    9495                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    9596               ELSE 
    96                   zdepmin = MIN( 1., zdep / gdept_n(ji,jj,jk) ) 
     97                  zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 
    9798                  zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 
    9899                  zdepprod(ji,jj,jk) = zdepmin**0.273 
    … …  
    113114                  ! Ammonification in oxic waters with oxygen consumption 
    114115                  ! ----------------------------------------------------- 
    115                   zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    116                   zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
     116                  zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     117                  zolimi(ji,jj,jk) = MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit )  
    117118                  ! Ammonification in suboxic waters with denitrification 
    118119                  ! ------------------------------------------------------- 
    119                   zammonic = zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
     120                  zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
    120121                  denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    121                   denitr(ji,jj,jk)  = MIN( ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
     122                  denitr(ji,jj,jk)  = MIN( ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) 
    122123                  zoxyremc          = zammonic - denitr(ji,jj,jk) 
    123124                  ! 
    … …  
    127128 
    128129                  ! 
    129                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    130                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    131                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 
    132                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
    133                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 
    134                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
    135                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
     130                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     131                  tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     132                  tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr (ji,jj,jk) * rdenit 
     133                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc 
     134                  tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimi (ji,jj,jk) * o2ut 
     135                  tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc 
     136                  tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimi(ji,jj,jk) + zoxyremc    & 
    136137                  &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
    137138               END DO 
    … …  
    154155                  ! Ammonification in oxic waters with oxygen consumption 
    155156                  ! ----------------------------------------------------- 
    156                   zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    157                   zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) )  
     157                  zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr(ji,jj,jk,jpdoc,Kbb)  
     158                  zolimic = MAX( 0.e0, MIN( ( tr(ji,jj,jk,jpoxy,Kbb) - rtrn ) / o2ut, zolimit ) )  
    158159                  zolimi(ji,jj,jk) = zolimic 
    159                   zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    160                   zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )  
     160                  zolimin = zremikn * zolimic * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     161                  zolimip = zremikp * zolimic * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn )  
    161162 
    162163                  ! Ammonification in suboxic waters with denitrification 
    163164                  ! ------------------------------------------------------- 
    164                   zammonic = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
     165                  zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 
    165166                  denitr(ji,jj,jk)  = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 
    166                   denitr(ji,jj,jk)  = MAX(0., MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
     167                  denitr(ji,jj,jk)  = MAX(0., MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenit, denitr(ji,jj,jk) ) ) 
    167168                  zoxyremc          = MAX(0., zammonic - denitr(ji,jj,jk)) 
    168                   zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    169                   zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    170                   zoxyremn  = zremikn * zoxyremc * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    171                   zoxyremp  = zremikp * zoxyremc * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
    172  
    173                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp + zoxyremp 
    174                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn + zoxyremn 
    175                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit 
    176                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) - zoxyremc 
    177                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn - zoxyremn 
    178                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp - zoxyremp 
    179                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut 
    180                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) + zoxyremc 
    181                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
     169                  zdenitrn  = zremikn * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     170                  zdenitrp  = zremikp * denitr(ji,jj,jk) * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     171                  zoxyremn  = zremikn * zoxyremc * tr(ji,jj,jk,jpdon,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     172                  zoxyremp  = zremikp * zoxyremc * tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdoc,Kbb) + rtrn ) 
     173 
     174                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zolimip + zdenitrp + zoxyremp 
     175                  tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zolimin + zdenitrn + zoxyremn 
     176                  tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - denitr(ji,jj,jk) * rdenit 
     177                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zolimic - denitr(ji,jj,jk) - zoxyremc 
     178                  tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zolimin - zdenitrn - zoxyremn 
     179                  tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zolimip - zdenitrp - zoxyremp 
     180                  tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - zolimic * o2ut 
     181                  tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zolimic + denitr(ji,jj,jk) + zoxyremc 
     182                  tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zolimin + zoxyremn + ( rdenit + 1.) * zdenitrn ) 
    182183               END DO 
    183184            END DO 
    … …  
    193194               ! below 2 umol/L. Inhibited at strong light  
    194195               ! ---------------------------------------------------------- 
    195                zonitr  = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  & 
     196               zonitr  = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) )  & 
    196197               &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
    197                zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
    198                zdenitnh4 = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenita, zdenitnh4 )  
     198               zdenitnh4 = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * nitrfac(ji,jj,jk) 
     199               zdenitnh4 = MIN(  ( tr(ji,jj,jk,jpno3,Kbb) - rtrn ) / rdenita, zdenitnh4 )  
    199200               ! Update of the tracers trends 
    200201               ! ---------------------------- 
    201                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 
    202                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 
    203                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    204                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
     202               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zonitr - zdenitnh4 
     203               tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + zonitr - rdenita * zdenitnh4 
     204               tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2nit * zonitr 
     205               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
    205206            END DO 
    206207         END DO 
    … …  
    210211         WRITE(charout, FMT="('rem1')") 
    211212         CALL prt_ctl_trc_info(charout) 
    212          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     213         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    213214       ENDIF 
    214215 
    … …  
    222223               ! ---------------------------------------------------------- 
    223224               zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
    224                   &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    & 
     225                  &              * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) )    & 
    225226                  &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
    226                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33 
    227                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25 
    228                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08 
     227               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zbactfer*0.33 
     228               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zbactfer*0.25 
     229               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zbactfer*0.08 
    229230               zfebact(ji,jj,jk)   = zbactfer * 0.33 
    230231               blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
    … …  
    236237         WRITE(charout, FMT="('rem2')") 
    237238         CALL prt_ctl_trc_info(charout) 
    238          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     239         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    239240       ENDIF 
    240241 
    … …  
    247248            DO ji = 1, jpi 
    248249               zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
    249                zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
    250                zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 
    251                znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
     250               zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
     251               zsatur2  = ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 400.)**37 
     252               znusil   = 0.225  * ( 1. + ts(ji,jj,jk,jp_tem,Kmm) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
    252253               ! Remineralization rate of BSi depedant on T and saturation 
    253254               ! --------------------------------------------------------- 
    254                IF ( gdept_n(ji,jj,jk) > zdep ) THEN 
     255               IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
    255256                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
    256                   &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
     257                  &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
    257258                  zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
    258259                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
    259                   &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
     260                  &                   * znusil * e3t(ji,jj,jk,Kmm) / wsbio4(ji,jj,jk) ) 
    260261               ENDIF 
    261262               zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
    262                zosil    = zsiremin * trb(ji,jj,jk,jpgsi) 
     263               zosil    = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 
    263264               ! 
    264                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 
    265                tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
     265               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) - zosil 
     266               tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) + zosil 
    266267            END DO 
    267268         END DO 
    … …  
    271272         WRITE(charout, FMT="('rem3')") 
    272273         CALL prt_ctl_trc_info(charout) 
    273          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     274         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    274275       ENDIF 
    275276 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsbc.F90

    r10522 r10975  
    8686CONTAINS 
    8787 
    88    SUBROUTINE p4z_sbc( kt ) 
     88   SUBROUTINE p4z_sbc( kt, Kmm ) 
    8989      !!---------------------------------------------------------------------- 
    9090      !!                  ***  routine p4z_sbc  *** 
    … …  
    9898      !!---------------------------------------------------------------------- 
    9999      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     100      INTEGER, INTENT(in) ::   Kmm  ! time level indices 
    100101      ! 
    101102      INTEGER  ::   ji, jj  
    … …  
    177178             zcoef = rno3 * 14E6 * ryyss 
    178179             CALL fld_read( kt, 1, sf_ndepo ) 
    179              nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) ) 
     180             nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t(:,:,1,Kmm) ) 
    180181         ENDIF 
    181182         IF( .NOT.ln_linssh ) THEN 
    182183           zcoef = rno3 * 14E6 * ryyss 
    183            nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) ) 
     184           nitdep(:,:) = MAX( rtrn, sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t(:,:,1,Kmm) ) 
    184185         ENDIF 
    185186      ENDIF 
    … …  
    190191 
    191192 
    192    SUBROUTINE p4z_sbc_init 
     193   SUBROUTINE p4z_sbc_init( Kmm ) 
    193194      !!---------------------------------------------------------------------- 
    194195      !!                  ***  routine p4z_sbc_init  *** 
    … …  
    202203      !! 
    203204      !!---------------------------------------------------------------------- 
     205      INTEGER, INTENT(in) ::   Kmm  ! time level indices 
    204206      INTEGER  :: ji, jj, jk, jm, ifpr 
    205207      INTEGER  :: ii0, ii1, ij0, ij1 
    … …  
    286288      IF( l_offline ) THEN 
    287289        nk_rnf(:,:) = 1 
    288         h_rnf (:,:) = gdept_n(:,:,1) 
     290        h_rnf (:,:) = gdept(:,:,1,Kmm) 
    289291      ENDIF 
    290292 
    … …  
    299301         ! 
    300302         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
    301          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' ) 
    302          ! 
    303          CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' ) 
     303         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sbc_init: unable to allocate sf_dust structure' ) 
     304         ! 
     305         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sbc_init', 'Atmospheric dust deposition', 'nampissed' ) 
    304306                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   ) 
    305307         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 
    … …  
    323325         ! 
    324326         ALLOCATE( sf_solub(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
    325          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_solub structure' ) 
    326          ! 
    327          CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sed_init', 'Solubility of atm. iron ', 'nampissed' ) 
     327         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sbc_init: unable to allocate sf_solub structure' ) 
     328         ! 
     329         CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sbc_init', 'Solubility of atm. iron ', 'nampissed' ) 
    328330                                   ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1)   ) 
    329331         IF( sn_solub%ln_tint )    ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) ) 
    … …  
    348350         rivinput(:) = 0._wp 
    349351 
    350          IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' ) 
    351          ! 
    352          CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sed_init', 'Input from river ', 'nampissed' ) 
     352         IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sbc_init: unable to allocate sf_irver structure' ) 
     353         ! 
     354         CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sbc_init', 'Input from river ', 'nampissed' ) 
    353355         DO ifpr = 1, jpriv 
    354356                                          ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1  ) ) 
    … …  
    397399         ! 
    398400         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
    399          IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_ndepo structure' ) 
    400          ! 
    401          CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Nutrient atmospheric depositon ', 'nampissed' ) 
     401         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sbc_init: unable to allocate sf_ndepo structure' ) 
     402         ! 
     403         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sbc_init', 'Nutrient atmospheric depositon ', 'nampissed' ) 
    402404                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   ) 
    403405         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) ) 
    … …  
    453455            DO jj = 1, jpj 
    454456               DO ji = 1, jpi 
    455                   zexpide   = MIN( 8.,( gdept_n(ji,jj,jk) / 500. )**(-1.5) ) 
     457                  zexpide   = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 
    456458                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
    457459                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    … …  
    487489      ENDIF 
    488490      !  
    489       IF( ll_sbc ) CALL p4z_sbc( nit000 )  
     491      IF( ll_sbc ) CALL p4z_sbc( nit000, Kmm )  
    490492      ! 
    491493      IF(lwp) THEN  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsed.F90

    r10425 r10975  
    3939CONTAINS 
    4040 
    41    SUBROUTINE p4z_sed( kt, knt ) 
     41   SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs ) 
    4242      !!--------------------------------------------------------------------- 
    4343      !!                     ***  ROUTINE p4z_sed  *** 
    … …  
    5151      ! 
    5252      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     53      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5354      INTEGER  ::  ji, jj, jk, ikt 
    5455      REAL(wp) ::  zrivalk, zrivsil, zrivno3 
    … …  
    102103         DO jj = 1, jpj 
    103104            DO ji = 1, jpi 
    104                zdep    = rfact2 / e3t_n(ji,jj,1) 
     105               zdep    = rfact2 / e3t(ji,jj,1,Kmm) 
    105106               zwflux  = fmmflx(ji,jj) / 1000._wp 
    106                zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep 
     107               zfminus = MIN( 0._wp, -zwflux ) * tr(ji,jj,1,jpfer,Kbb) * zdep 
    107108               zfplus  = MAX( 0._wp, -zwflux ) * icefeinput * zdep 
    108109               zironice(ji,jj) =  zfplus + zfminus 
    … …  
    110111         END DO 
    111112         ! 
    112          tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)  
     113         tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:)  
    113114         !  
    114115         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   & 
    115             &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
     116            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! iron flux from ice 
    116117         ! 
    117118         DEALLOCATE( zironice ) 
    … …  
    126127         !                                              ! Iron and Si deposition at the surface 
    127128         IF( ln_solub ) THEN 
    128             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     129            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t(:,:,1,Kmm) / 55.85 + 3.e-10 * r1_ryyss  
    129130         ELSE 
    130             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    131          ENDIF 
    132          zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
    133          zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
     131            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t(:,:,1,Kmm) / 55.85 + 3.e-10 * r1_ryyss  
     132         ENDIF 
     133         zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t(:,:,1,Kmm) / 28.1  
     134         zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t(:,:,1,Kmm) / 31. / po4r  
    134135         !                                              ! Iron solubilization of particles in the water column 
    135136         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    136137         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 
    137138         DO jk = 2, jpkm1 
    138             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
     139            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept(:,:,jk,Kmm) / 540. ) 
    139140            zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023 
    140141         END DO 
    141142         !                                              ! Iron solubilization of particles in the water column 
    142          tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:) 
     143         tr(:,:,1,jpsil,Krhs) = tr(:,:,1,jpsil,Krhs) + zsidep  (:,:) 
    143144         DO jk = 1, jpkm1 
    144             tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zpdep   (:,:,jk) 
    145             tra(:,:,jk,jpfer) = tra(:,:,jk,jpfer) + zirondep(:,:,jk)  
     145            tr(:,:,jk,jppo4,Krhs) = tr(:,:,jk,jppo4,Krhs) + zpdep   (:,:,jk) 
     146            tr(:,:,jk,jpfer,Krhs) = tr(:,:,jk,jpfer,Krhs) + zirondep(:,:,jk)  
    146147         ENDDO 
    147148         !  
    … …  
    149150            IF( knt == nrdttrc ) THEN 
    150151                IF( iom_use( "Irondep" ) )   & 
    151                 &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
     152                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    152153                IF( iom_use( "pdust" ) )   & 
    153154                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
    … …  
    164165            DO ji = 1, jpi 
    165166               DO jk = 1, nk_rnf(ji,jj) 
    166                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2 
    167                   tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2 
    168                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    169                   tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2 
    170                   tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2 
    171                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 
    172                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) +  rivdoc(ji,jj) * rfact2 
     167                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) +  rivdip(ji,jj) * rfact2 
     168                  tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) +  rivdin(ji,jj) * rfact2 
     169                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) +  rivdic(ji,jj) * 5.e-5 * rfact2 
     170                  tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) +  rivdsi(ji,jj) * rfact2 
     171                  tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) +  rivdic(ji,jj) * rfact2 
     172                  tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 
     173                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) +  rivdoc(ji,jj) * rfact2 
    173174               ENDDO 
    174175            ENDDO 
    … …  
    178179               DO ji = 1, jpi 
    179180                  DO jk = 1, nk_rnf(ji,jj) 
    180                      tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) +  rivdic(ji,jj) * 5.e-5 * rfact2 
     181                     tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) +  rivdic(ji,jj) * 5.e-5 * rfact2 
    181182                  ENDDO 
    182183               ENDDO 
    … …  
    187188               DO ji = 1, jpi 
    188189                  DO jk = 1, nk_rnf(ji,jj) 
    189                      tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 
    190                      tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 
     190                     tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + rivdop(ji,jj) * rfact2 
     191                     tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + rivdon(ji,jj) * rfact2 
    191192                  ENDDO 
    192193               ENDDO 
    … …  
    198199      ! ---------------------------------------------------------- 
    199200      IF( ln_ndepo ) THEN 
    200          tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 
    201          tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
     201         tr(:,:,1,jpno3,Krhs) = tr(:,:,1,jpno3,Krhs) + nitdep(:,:) * rfact2 
     202         tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * nitdep(:,:) * rfact2 
    202203      ENDIF 
    203204 
    … …  
    205206      ! ------------------------------------------------------ 
    206207      IF( ln_hydrofe ) THEN 
    207             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
     208            tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + hydrofe(:,:,:) * rfact2 
    208209         IF( ln_ligand ) THEN 
    209             tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
     210            tr(:,:,:,jplgw,Krhs) = tr(:,:,:,jplgw,Krhs) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
    210211         ENDIF 
    211212         ! 
    … …  
    219220         DO ji = 1, jpi 
    220221            ikt  = mbkt(ji,jj) 
    221             zdep = e3t_n(ji,jj,ikt) / xstep 
     222            zdep = e3t(ji,jj,ikt,Kmm) / xstep 
    222223            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 
    223224            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) 
    … …  
    230231         ! ------------------------------------------------------ 
    231232         IF( ln_ironsed ) THEN 
    232                             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
     233                            tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + ironsed(:,:,:) * rfact2 
    233234            ! 
    234235            IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
    … …  
    243244              IF( tmask(ji,jj,1) == 1 ) THEN 
    244245                 ikt = mbkt(ji,jj) 
    245                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    246                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     246                 zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     247                   &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
    247248                 zflx  = LOG10( MAX( 1E-3, zflx ) ) 
    248                  zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    249                  zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    250                  zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
     249                 zo2   = LOG10( MAX( 10. , tr(ji,jj,ikt,jpoxy,Kbb) * 1E6 ) ) 
     250                 zno3  = LOG10( MAX( 1.  , tr(ji,jj,ikt,jpno3,Kbb) * 1E6 * rno3 ) ) 
     251                 zdep  = LOG10( gdepw(ji,jj,ikt+1,Kmm) ) 
    251252                 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    252253                   &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
    253254                 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
    254255                   ! 
    255                  zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    256                    &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
     256                 zflx = (  tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj)   & 
     257                   &     + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 
    257258                 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    258259              ENDIF 
    … …  
    270271         DO ji = 1, jpi 
    271272            ikt  = mbkt(ji,jj) 
    272             zdep = xstep / e3t_n(ji,jj,ikt)  
     273            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    273274            zwsc = zwsbio4(ji,jj) * zdep 
    274             zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    275             zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
     275            zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     276            zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
    276277            ! 
    277             tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 
    278             tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 
     278            tr(ji,jj,ikt,jpgsi,Krhs) = tr(ji,jj,ikt,jpgsi,Krhs) - zsiloss 
     279            tr(ji,jj,ikt,jpcal,Krhs) = tr(ji,jj,ikt,jpcal,Krhs) - zcaloss 
    279280         END DO 
    280281      END DO 
    … …  
    284285            DO ji = 1, jpi 
    285286               ikt  = mbkt(ji,jj) 
    286                zdep = xstep / e3t_n(ji,jj,ikt)  
     287               zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    287288               zwsc = zwsbio4(ji,jj) * zdep 
    288                zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    289                zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
    290                tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
     289               zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 
     290               zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 
     291               tr(ji,jj,ikt,jpsil,Krhs) = tr(ji,jj,ikt,jpsil,Krhs) + zsiloss * zrivsil  
    291292               ! 
    292293               zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    293294               zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    294295               zrivalk  = sedcalfrac * zfactcal 
    295                tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    296                tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
    297                zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t_n(ji,jj,ikt)  
    298                zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t_n(ji,jj,ikt)  
     296               tr(ji,jj,ikt,jptal,Krhs) =  tr(ji,jj,ikt,jptal,Krhs) + zcaloss * zrivalk * 2.0 
     297               tr(ji,jj,ikt,jpdic,Krhs) =  tr(ji,jj,ikt,jpdic,Krhs) + zcaloss * zrivalk 
     298               zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * e3t(ji,jj,ikt,Kmm)  
     299               zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * e3t(ji,jj,ikt,Kmm)  
    299300            END DO 
    300301         END DO 
    … …  
    304305         DO ji = 1, jpi 
    305306            ikt  = mbkt(ji,jj) 
    306             zdep = xstep / e3t_n(ji,jj,ikt)  
     307            zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    307308            zws4 = zwsbio4(ji,jj) * zdep 
    308309            zws3 = zwsbio3(ji,jj) * zdep 
    309             tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4  
    310             tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
    311             tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 
    312             tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
     310            tr(ji,jj,ikt,jpgoc,Krhs) = tr(ji,jj,ikt,jpgoc,Krhs) - tr(ji,jj,ikt,jpgoc,Kbb) * zws4  
     311            tr(ji,jj,ikt,jppoc,Krhs) = tr(ji,jj,ikt,jppoc,Krhs) - tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     312            tr(ji,jj,ikt,jpbfe,Krhs) = tr(ji,jj,ikt,jpbfe,Krhs) - tr(ji,jj,ikt,jpbfe,Kbb) * zws4 
     313            tr(ji,jj,ikt,jpsfe,Krhs) = tr(ji,jj,ikt,jpsfe,Krhs) - tr(ji,jj,ikt,jpsfe,Kbb) * zws3 
    313314         END DO 
    314315      END DO 
    … …  
    318319            DO ji = 1, jpi 
    319320               ikt  = mbkt(ji,jj) 
    320                zdep = xstep / e3t_n(ji,jj,ikt)  
     321               zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    321322               zws4 = zwsbio4(ji,jj) * zdep 
    322323               zws3 = zwsbio3(ji,jj) * zdep 
    323                tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 
    324                tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 
    325                tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 
    326                tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 
     324               tr(ji,jj,ikt,jpgon,Krhs) = tr(ji,jj,ikt,jpgon,Krhs) - tr(ji,jj,ikt,jpgon,Kbb) * zws4 
     325               tr(ji,jj,ikt,jppon,Krhs) = tr(ji,jj,ikt,jppon,Krhs) - tr(ji,jj,ikt,jppon,Kbb) * zws3 
     326               tr(ji,jj,ikt,jpgop,Krhs) = tr(ji,jj,ikt,jpgop,Krhs) - tr(ji,jj,ikt,jpgop,Kbb) * zws4 
     327               tr(ji,jj,ikt,jppop,Krhs) = tr(ji,jj,ikt,jppop,Krhs) - tr(ji,jj,ikt,jppop,Kbb) * zws3 
    327328            END DO 
    328329         END DO 
    … …  
    335336            DO ji = 1, jpi 
    336337               ikt  = mbkt(ji,jj) 
    337                zdep = xstep / e3t_n(ji,jj,ikt)  
     338               zdep = xstep / e3t(ji,jj,ikt,Kmm)  
    338339               zws4 = zwsbio4(ji,jj) * zdep 
    339340               zws3 = zwsbio3(ji,jj) * zdep 
    340341               zrivno3 = 1. - zbureff(ji,jj) 
    341                zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
    342                zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     342               zwstpoc = tr(ji,jj,ikt,jpgoc,Kbb) * zws4 + tr(ji,jj,ikt,jppoc,Kbb) * zws3 
     343               zpdenit  = MIN( 0.5 * ( tr(ji,jj,ikt,jpno3,Kbb) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    343344               z1pdenit = zwstpoc * zrivno3 - zpdenit 
    344                zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    345                tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit 
    346                tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit 
    347                tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit 
    348                tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit 
    349                tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
    350                tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
    351                tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit  
    352                sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    353                zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t_n(ji,jj,ikt) 
     345               zolimit = MIN( ( tr(ji,jj,ikt,jpoxy,Kbb) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     346               tr(ji,jj,ikt,jpdoc,Krhs) = tr(ji,jj,ikt,jpdoc,Krhs) + z1pdenit - zolimit 
     347               tr(ji,jj,ikt,jppo4,Krhs) = tr(ji,jj,ikt,jppo4,Krhs) + zpdenit + zolimit 
     348               tr(ji,jj,ikt,jpnh4,Krhs) = tr(ji,jj,ikt,jpnh4,Krhs) + zpdenit + zolimit 
     349               tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) - rdenit * zpdenit 
     350               tr(ji,jj,ikt,jpoxy,Krhs) = tr(ji,jj,ikt,jpoxy,Krhs) - zolimit * o2ut 
     351               tr(ji,jj,ikt,jptal,Krhs) = tr(ji,jj,ikt,jptal,Krhs) + rno3 * (zolimit + (1.+rdenit) * zpdenit ) 
     352               tr(ji,jj,ikt,jpdic,Krhs) = tr(ji,jj,ikt,jpdic,Krhs) + zpdenit + zolimit  
     353               sdenit(ji,jj) = rdenit * zpdenit * e3t(ji,jj,ikt,Kmm) 
     354               zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc * e3t(ji,jj,ikt,Kmm) 
    354355               IF( ln_p5z ) THEN 
    355                   zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 
    356                   zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 
    357                   tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
    358                   tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
     356                  zwstpop              = tr(ji,jj,ikt,jpgop,Kbb) * zws4 + tr(ji,jj,ikt,jppop,Kbb) * zws3 
     357                  zwstpon              = tr(ji,jj,ikt,jpgon,Kbb) * zws4 + tr(ji,jj,ikt,jppon,Kbb) * zws3 
     358                  tr(ji,jj,ikt,jpdon,Krhs) = tr(ji,jj,ikt,jpdon,Krhs) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn) 
     359                  tr(ji,jj,ikt,jpdop,Krhs) = tr(ji,jj,ikt,jpdop,Krhs) + ( z1pdenit - zolimit ) * zwstpop / (zwstpoc + rtrn) 
    359360               ENDIF 
    360361            END DO 
    … …  
    375376               DO ji = 1, jpi 
    376377                  !                      ! Potential nitrogen fixation dependant on temperature and iron 
    377                   ztemp = tsn(ji,jj,jk,jp_tem) 
     378                  ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
    378379                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    379380                  !       Potential nitrogen fixation dependant on temperature and iron 
    380                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    381                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
     381                  xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     382                  xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
    382383                  zlim = ( 1.- xdiano3 - xdianh4 ) 
    383384                  IF( zlim <= 0.1 )   zlim = 0.01 
    384385                  zfact = zlim * rfact2 
    385386                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    386                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
     387                  ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
    387388                  ztrdp = ztrpo4(ji,jj,jk) 
    388389                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    … …  
    395396               DO ji = 1, jpi 
    396397                  !                      ! Potential nitrogen fixation dependant on temperature and iron 
    397                   ztemp = tsn(ji,jj,jk,jp_tem) 
     398                  ztemp = ts(ji,jj,jk,jp_tem,Kmm) 
    398399                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
    399400                  !       Potential nitrogen fixation dependant on temperature and iron 
    400                   xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
    401                   xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
     401                  xdianh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     402                  xdiano3 = tr(ji,jj,jk,jpno3,Kbb) / ( concnno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - xdianh4) 
    402403                  zlim = ( 1.- xdiano3 - xdianh4 ) 
    403404                  IF( zlim <= 0.1 )   zlim = 0.01 
    404405                  zfact = zlim * rfact2 
    405406                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
    406                   ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
    407                   ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 
     407                  ztrpo4(ji,jj,jk) = tr(ji,jj,jk,jppo4,Kbb) / ( 1E-6 + tr(ji,jj,jk,jppo4,Kbb) ) 
     408                  ztrdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( 1E-6 + tr(ji,jj,jk,jpdop,Kbb) ) * (1. - ztrpo4(ji,jj,jk)) 
    408409                  ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
    409410                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
    … …  
    420421               DO ji = 1, jpi 
    421422                  zfact = nitrpot(ji,jj,jk) * nitrfix 
    422                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    423                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    424                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0 
    425                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    426                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    427                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    428                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    429                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
    430                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    431                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    432                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    433                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
    434                   &                     * 0.001 * trb(ji,jj,jk,jpdoc) * xstep 
     423                  tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     424                  tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     425                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zfact * 2.0 / 3.0 
     426                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     427                  tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     428                  tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     429                  tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     430                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0 
     431                  tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     432                  tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     433                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     434                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + concdnh4 / ( concdnh4 + tr(ji,jj,jk,jppo4,Kbb) ) & 
     435                  &                     * 0.001 * tr(ji,jj,jk,jpdoc,Kbb) * xstep 
    435436              END DO 
    436437            END DO  
    … …  
    441442               DO ji = 1, jpi 
    442443                  zfact = nitrpot(ji,jj,jk) * nitrfix 
    443                   tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
    444                   tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
    445                   tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
     444                  tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 
     445                  tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zfact / 3.0 
     446                  tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
    446447                  &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    447                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 
    448                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
    449                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  & 
     448                  tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zfact * 1.0 / 3.0 
     449                  tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zfact * 1.0 / 3.0 
     450                  tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + 16.0 / 46.0 * zfact / 3.0  & 
    450451                  &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
    451452                  &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
    452                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
    453                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 
    454                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
    455                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
    456                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 
    457                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
    458                   tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
    459                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0  
    460                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
    461                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
    462                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     453                  tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     454                  tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zfact * 1.0 / 3.0 * 2.0 /3.0 
     455                  tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
     456                  tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     457                  tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zfact * 1.0 / 3.0 * 1.0 /3.0 
     458                  tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
     459                  tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     460                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - 30E-6 * zfact * 1.0 / 3.0  
     461                  tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     462                  tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     463                  tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
    463464              END DO 
    464465            END DO  
    … …  
    474475               zwork(:,:) = 0. 
    475476               DO jk = 1, jpkm1 
    476                  zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
     477                 zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    477478               ENDDO 
    478479               CALL iom_put( "INTNFIX" , zwork )  
    … …  
    488489         WRITE(charout, fmt="('sed ')") 
    489490         CALL prt_ctl_trc_info(charout) 
    490          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     491         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    491492      ENDIF 
    492493      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsink.F90

    r10966 r10975  
    4949   !!---------------------------------------------------------------------- 
    5050 
    51    SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm ) 
     51   SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm, Krhs ) 
    5252      !!--------------------------------------------------------------------- 
    5353      !!                     ***  ROUTINE p4z_sink  *** 
    … …  
    5959      !!--------------------------------------------------------------------- 
    6060      INTEGER, INTENT(in) :: kt, knt 
    61       INTEGER, INTENT(in) :: Kbb, Kmm  ! time level indices 
     61      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs  ! time level indices 
    6262      INTEGER  ::   ji, jj, jk 
    6363      CHARACTER (len=25) :: charout 
    … …  
    8484            DO ji = 1,jpi 
    8585               zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
    86                zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale 
     86               zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 
    8787               wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
    8888            END DO 
    … …  
    176176         WRITE(charout, FMT="('sink')") 
    177177         CALL prt_ctl_trc_info(charout) 
    178          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     178         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    179179      ENDIF 
    180180      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90

    r10966 r10975  
    4646CONTAINS 
    4747 
    48    SUBROUTINE p4z_sms( kt, Kbb, Kmm ) 
     48   SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 
    4949      !!--------------------------------------------------------------------- 
    5050      !!                     ***  ROUTINE p4z_sms  *** 
    … …  
    5858      !!--------------------------------------------------------------------- 
    5959      ! 
    60       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index       
    61       INTEGER, INTENT( in ) ::   Kbb, Kmm     ! time level index 
     60      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index       
     61      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level index 
    6262      !! 
    6363      INTEGER ::   ji, jj, jk, jnt, jn, jl 
    … …  
    7373        ! 
    7474        IF( .NOT. ln_rsttr ) THEN 
    75             CALL p4z_che                              ! initialize the chemical constants 
    76             CALL ahini_for_at(hi)   !  set PH at kt=nit000 
     75            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     76            CALL ahini_for_at( hi, Kbb )              !  set PH at kt=nit000 
    7777            t_oce_co2_flx_cum = 0._wp 
    7878        ELSE 
    79             CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields 
     79            CALL p4z_rst( nittrc000, Kbb, Kmm,  'READ' )  !* read or initialize all required fields 
    8080        ENDIF 
    8181        ! 
    8282      ENDIF 
    8383      ! 
    84       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
     84      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt, Kbb, Kmm )      ! Relaxation of some tracers 
    8585      ! 
    8686      rfact = r2dttrc 
    … …  
    9999      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
    100100         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
    101             trb(:,:,:,jn) = trn(:,:,:,jn) 
     101            tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 
    102102         END DO 
    103103      ENDIF 
    104104      ! 
    105       IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients  
     105      IF( ll_sbc ) CALL p4z_sbc( kt, Kmm )   ! external sources of nutrients  
    106106      ! 
    107107#if ! defined key_sed_off 
    108       CALL p4z_che              ! computation of chemical constants 
    109       CALL p4z_int( kt )        ! computation of various rates for biogeochemistry 
     108      CALL p4z_che(     Kbb, Kmm       ) ! computation of chemical constants 
     109      CALL p4z_int( kt, Kbb, Kmm       ) ! computation of various rates for biogeochemistry 
    110110      ! 
    111111      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    112112         ! 
    113          CALL p4z_bio( kt, jnt, Kbb, Kmm )   ! Biology 
    114          CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation 
    115          CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions 
    116          CALL p4z_flx( kt, jnt )   ! Compute surface fluxes 
     113         CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs )   ! Biology 
     114         CALL p4z_lys( kt, jnt, Kbb,      Krhs )   ! Compute CaCO3 saturation 
     115         CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs )   ! Surface and Bottom boundary conditions 
     116         CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs )   ! Compute surface fluxes 
    117117         ! 
    118118         xnegtr(:,:,:) = 1.e0 
    … …  
    121121               DO jj = 1, jpj 
    122122                  DO ji = 1, jpi 
    123                      IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
    124                         ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 
     123                     IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 
     124                        ztra             = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 
    125125                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
    126126                     ENDIF 
    … …  
    132132         !                                !  
    133133         DO jn = jp_pcs0, jp_pcs1 
    134            trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
     134           tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 
    135135         END DO 
    136136        ! 
    137137         DO jn = jp_pcs0, jp_pcs1 
    138             tra(:,:,:,jn) = 0._wp 
     138            tr(:,:,:,jn,Krhs) = 0._wp 
    139139         END DO 
    140140         ! 
    141141         IF( ln_top_euler ) THEN 
    142142            DO jn = jp_pcs0, jp_pcs1 
    143                trn(:,:,:,jn) = trb(:,:,:,jn) 
     143               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    144144            END DO 
    145145         ENDIF 
    … …  
    149149      IF( l_trdtrc ) THEN 
    150150         DO jn = jp_pcs0, jp_pcs1 
    151            CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt, Kmm )   ! save trends 
     151           CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm )   ! save trends 
    152152         END DO 
    153153      END IF 
    … …  
    156156      IF( ln_sediment ) THEN  
    157157         ! 
    158          CALL sed_model( kt, Kmm )     !  Main program of Sediment model 
     158         CALL sed_model( kt, Kbb, Kmm, Krhs )     !  Main program of Sediment model 
    159159         ! 
    160160         IF( ln_top_euler ) THEN 
    161161            DO jn = jp_pcs0, jp_pcs1 
    162                trn(:,:,:,jn) = trb(:,:,:,jn) 
     162               tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 
    163163            END DO 
    164164         ENDIF 
    … …  
    166166      ENDIF 
    167167      ! 
    168       IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file  
    169       ! 
    170  
    171       IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt )    ! Mass conservation checking 
    172  
    173       IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )       ! flush output namelist PISCES 
     168      IF( lrst_trc )  CALL p4z_rst( kt, Kbb, Kmm,  'WRITE' )           !* Write PISCES informations in restart file  
     169      ! 
     170 
     171      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 
     172 
     173      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )         ! flush output namelist PISCES 
    174174      ! 
    175175      IF( ln_timing )  CALL timing_stop('p4z_sms') 
    … …  
    265265 
    266266 
    267    SUBROUTINE p4z_rst( kt, cdrw ) 
     267   SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 
    268268      !!--------------------------------------------------------------------- 
    269269      !!                   ***  ROUTINE p4z_rst  *** 
    … …  
    276276      !!--------------------------------------------------------------------- 
    277277      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     278      INTEGER         , INTENT(in) ::   Kbb, Kmm   ! time level indices 
    278279      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    279280      !!--------------------------------------------------------------------- 
    … …  
    288289            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    289290         ELSE 
    290             CALL p4z_che                              ! initialize the chemical constants 
    291             CALL ahini_for_at(hi) 
     291            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
     292            CALL ahini_for_at( hi, Kbb ) 
    292293         ENDIF 
    293294         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
    … …  
    336337 
    337338 
    338    SUBROUTINE p4z_dmp( kt ) 
     339   SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 
    339340      !!---------------------------------------------------------------------- 
    340341      !!                    ***  p4z_dmp  *** 
    … …  
    343344      !!---------------------------------------------------------------------- 
    344345      ! 
    345       INTEGER, INTENT( in )  ::     kt ! time step 
     346      INTEGER, INTENT( in )  ::     kt            ! time step 
     347      INTEGER, INTENT( in )  ::     Kbb, Kmm      ! time level indices 
    346348      ! 
    347349      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    … …  
    364366            zarea          = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6               
    365367 
    366             zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    367             zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    368             zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    369             zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     368            zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:)  ) * zarea 
     369            zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:)  ) * zarea * po4r 
     370            zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:)  ) * zarea * rno3 
     371            zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:)  ) * zarea 
    370372  
    371373            IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn 
    372             trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 
     374            tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 
    373375 
    374376            IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
    375             trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 
     377            tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 
    376378 
    377379            IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
    378             trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 
     380            tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 
    379381 
    380382            IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
    381             trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 
     383            tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 
    382384            ! 
    383385            ! 
    384386            IF( .NOT. ln_top_euler ) THEN 
    385                zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    386                zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    387                zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    388                zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     387               zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:)  ) * zarea 
     388               zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:)  ) * zarea * po4r 
     389               zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:)  ) * zarea * rno3 
     390               zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:)  ) * zarea 
    389391  
    390392               IF(lwp) WRITE(numout,*) ' ' 
    391393               IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb 
    392                trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 
     394               tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 
    393395 
    394396               IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
    395                trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 
     397               tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 
    396398 
    397399               IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
    398                trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 
     400               tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 
    399401 
    400402               IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
    401                trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 
     403               tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 
    402404           ENDIF 
    403405        ENDIF 
    … …  
    408410 
    409411 
    410    SUBROUTINE p4z_chk_mass( kt ) 
     412   SUBROUTINE p4z_chk_mass( kt, Kmm ) 
    411413      !!---------------------------------------------------------------------- 
    412414      !!                  ***  ROUTINE p4z_chk_mass  *** 
    … …  
    416418      !!--------------------------------------------------------------------- 
    417419      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     420      INTEGER, INTENT( in ) ::   Kmm     ! time level indices 
    418421      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
    419422      CHARACTER(LEN=100)   ::   cltxt 
    … …  
    439442         !   Compute the budget of NO3, ALK, Si, Fer 
    440443         IF( ln_p4z ) THEN 
    441             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      & 
    442                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    443                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    444                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     444            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm)                      & 
     445               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     446               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     447               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    445448        ELSE 
    446             zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   & 
    447                &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      &  
    448                &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   & 
    449                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3  
     449            zwork(:,:,:) =    tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm)   & 
     450               &          +   tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm)                      &  
     451               &          +   tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm)   & 
     452               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3  
    450453        ENDIF 
    451454        ! 
    … …  
    457460      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    458461         IF( ln_p4z ) THEN 
    459             zwork(:,:,:) =    trn(:,:,:,jppo4)                                         & 
    460                &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
    461                &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
    462                &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     462            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm)                                         & 
     463               &          +   tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm)                      & 
     464               &          +   tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm)  + tr(:,:,:,jpdoc,Kmm)  &         
     465               &          +   tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm)  
    463466        ELSE 
    464             zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      & 
    465                &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      &  
    466                &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   & 
    467                &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3  
     467            zwork(:,:,:) =    tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm)                      & 
     468               &          +   tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm)                      &  
     469               &          +   tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm)   & 
     470               &          + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3  
    468471        ENDIF 
    469472        ! 
    … …  
    474477      ! 
    475478      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    476          zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)  
     479         zwork(:,:,:) =  tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm)  
    477480         ! 
    478481         silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   
    … …  
    482485      ! 
    483486      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    484          zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.               
     487         zwork(:,:,:) =  tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2.               
    485488         ! 
    486489         alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )         ! 
    … …  
    490493      ! 
    491494      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    492          zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   & 
    493             &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      & 
    494             &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3     
     495         zwork(:,:,:) =   tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm)   & 
     496            &         +   tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm)                      & 
     497            &         + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) )  * ferat3     
    495498         ! 
    496499         ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )   

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zlim.F90

    r10425 r10975  
    9999CONTAINS 
    100100 
    101    SUBROUTINE p5z_lim( kt, knt ) 
     101   SUBROUTINE p5z_lim( kt, knt, Kbb, Kmm ) 
    102102      !!--------------------------------------------------------------------- 
    103103      !!                     ***  ROUTINE p5z_lim  *** 
    … …  
    110110      ! 
    111111      INTEGER, INTENT(in)  :: kt, knt 
     112      INTEGER, INTENT(in)  :: Kbb, Kmm  ! time level indices 
    112113      ! 
    113114      INTEGER  ::   ji, jj, jk 
    … …  
    134135               ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    135136               !------------------------------------- 
    136                zno3    = trb(ji,jj,jk,jpno3) / 40.e-6 
     137               zno3    = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 
    137138               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
    138139               zferlim = MIN( zferlim, 7e-11 ) 
    139                trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 
     140               tr(ji,jj,jk,jpfer,Kbb) = MAX( tr(ji,jj,jk,jpfer,Kbb), zferlim ) 
    140141 
    141142               ! Computation of the mean relative size of each community 
    142143               ! ------------------------------------------------------- 
    143                z1_trnphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    144                z1_trnpic   = 1. / ( trb(ji,jj,jk,jppic) + rtrn ) 
    145                z1_trndia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    146                znanochl = trb(ji,jj,jk,jpnch) * z1_trnphy 
    147                zpicochl = trb(ji,jj,jk,jppch) * z1_trnpic 
    148                zdiatchl = trb(ji,jj,jk,jpdch) * z1_trndia 
     144               z1_trnphy   = 1. / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     145               z1_trnpic   = 1. / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     146               z1_trndia   = 1. / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     147               znanochl = tr(ji,jj,jk,jpnch,Kbb) * z1_trnphy 
     148               zpicochl = tr(ji,jj,jk,jppch,Kbb) * z1_trnpic 
     149               zdiatchl = tr(ji,jj,jk,jpdch,Kbb) * z1_trndia 
    149150 
    150151               ! Computation of a variable Ks for iron on diatoms taking into account 
    … …  
    182183               ! Based on the different papers by Pahlow et al., and Smith et al. 
    183184               ! ----------------------------------------------------------------- 
    184                znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0nnh4,    & 
    185                  &         trb(ji,jj,jk,jpno3) / zconc0n) 
     185               znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4,    & 
     186                 &         tr(ji,jj,jk,jpno3,Kbb) / zconc0n) 
    186187               fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    187                znutlim = trb(ji,jj,jk,jppo4) / zconc0npo4 
     188               znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4 
    188189               fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    189190               znutlim = biron(ji,jj,jk) / zconcnfe 
    190191               fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    191                znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc0pnh4,    & 
    192                  &         trb(ji,jj,jk,jpno3) / zconc0p) 
     192               znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4,    & 
     193                 &         tr(ji,jj,jk,jpno3,Kbb) / zconc0p) 
    193194               fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    194                znutlim = trb(ji,jj,jk,jppo4) / zconc0ppo4 
     195               znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4 
    195196               fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    196197               znutlim = biron(ji,jj,jk) / zconcpfe 
    197198               fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    198                znutlim = MAX( trb(ji,jj,jk,jpnh4) / zconc1dnh4,    & 
    199                  &         trb(ji,jj,jk,jpno3) / zconc1d ) 
     199               znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4,    & 
     200                 &         tr(ji,jj,jk,jpno3,Kbb) / zconc1d ) 
    200201               fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    201                znutlim = trb(ji,jj,jk,jppo4) / zconc0dpo4 
     202               znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4 
    202203               fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 
    203204               znutlim = biron(ji,jj,jk) / zconcdfe 
    … …  
    206207               ! Michaelis-Menten Limitation term for nutrients Small bacteria 
    207208               ! ------------------------------------------------------------- 
    208                zbactnh4 = trb(ji,jj,jk,jpnh4) / ( concbnh4 + trb(ji,jj,jk,jpnh4) ) 
    209                zbactno3 = trb(ji,jj,jk,jpno3) / ( concbno3 + trb(ji,jj,jk,jpno3) ) * (1. - zbactnh4) 
     209               zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     210               zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4) 
    210211               ! 
    211212               zlim1    = zbactno3 + zbactnh4 
    212                zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbpo4) 
     213               zlim2    = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4) 
    213214               zlim3    = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 
    214                zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) ) 
     215               zlim4    = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc   + tr(ji,jj,jk,jpdoc,Kbb) ) 
    215216               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    216217               xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 
    … …  
    219220               ! ----------------------------------------------- 
    220221               zfalim = (1.-fanano) / fanano 
    221                xnanonh4(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0nnh4 + trb(ji,jj,jk,jpnh4) ) 
    222                xnanono3(ji,jj,jk) = (1. - fanano) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0n + trb(ji,jj,jk,jpno3) )  & 
     222               xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     223               xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) )  & 
    223224               &                    * (1. - xnanonh4(ji,jj,jk)) 
    224225               ! 
    225226               zfalim = (1.-fananop) / fananop 
    226                xnanopo4(ji,jj,jk) = (1. - fananop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0npo4 ) 
    227                xnanodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   & 
     227               xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 ) 
     228               xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )   & 
    228229               &                    * ( 1.0 - xnanopo4(ji,jj,jk) ) 
    229230               xnanodop(ji,jj,jk) = 0. 
    … …  
    232233               xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 
    233234               ! 
    234                zratiof   = trb(ji,jj,jk,jpnfe) * z1_trnphy 
     235               zratiof   = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy 
    235236               zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 
    236237               ! 
    237                zration = trb(ji,jj,jk,jpnph) * z1_trnphy 
     238               zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy 
    238239               zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 
    239240               fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn)  & 
    … …  
    250251               ! ---------------------------------------------------------------- 
    251252               zfalim = (1.-fapico) / fapico  
    252                xpiconh4(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc0pnh4 + trb(ji,jj,jk,jpnh4) ) 
    253                xpicono3(ji,jj,jk) = (1. - fapico) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc0p + trb(ji,jj,jk,jpno3) )  & 
     253               xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     254               xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) )  & 
    254255               &                    * (1. - xpiconh4(ji,jj,jk)) 
    255256               ! 
    256257               zfalim = (1.-fapicop) / fapicop  
    257                xpicopo4(ji,jj,jk) = (1. - fapicop) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0ppo4 ) 
    258                xpicodop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )   & 
     258               xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 ) 
     259               xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )   & 
    259260               &                    * ( 1.0 - xpicopo4(ji,jj,jk) ) 
    260261               xpicodop(ji,jj,jk) = 0. 
    … …  
    263264               xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 
    264265               ! 
    265                zratiof   = trb(ji,jj,jk,jppfe) * z1_trnpic 
     266               zratiof   = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic 
    266267               zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 
    267268               ! 
    268                zration   = trb(ji,jj,jk,jpnpi) * z1_trnpic 
     269               zration   = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic 
    269270               zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 
    270271               fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn)  & 
    … …  
    281282               !   ------------------------------------------------------ 
    282283               zfalim = (1.-fadiat) / fadiat  
    283                xdiatnh4(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpnh4) / ( zfalim * zconc1dnh4 + trb(ji,jj,jk,jpnh4) ) 
    284                xdiatno3(ji,jj,jk) = (1. - fadiat) * trb(ji,jj,jk,jpno3) / ( zfalim * zconc1d + trb(ji,jj,jk,jpno3) )  & 
     284               xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 
     285               xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) )  & 
    285286               &                    * (1. - xdiatnh4(ji,jj,jk)) 
    286287               ! 
    287288               zfalim = (1.-fadiatp) / fadiatp 
    288                xdiatpo4(ji,jj,jk) = (1. - fadiatp) * trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0dpo4 ) 
    289                xdiatdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc )  & 
     289               xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 ) 
     290               xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc )  & 
    290291               &                    * ( 1.0 - xdiatpo4(ji,jj,jk) ) 
    291292               xdiatdop(ji,jj,jk) = 0. 
    … …  
    294295               xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 
    295296               ! 
    296                zratiof   = trb(ji,jj,jk,jpdfe) * z1_trndia 
     297               zratiof   = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia 
    297298               zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 
    298299               ! 
    299                zration   = trb(ji,jj,jk,jpndi) * z1_trndia 
     300               zration   = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia 
    300301               zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 
    301302               fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn)   & 
    … …  
    305306               &          / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) )   & 
    306307               &          * xqndmax(ji,jj,jk) / (zration + rtrn) 
    307                zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
     308               zlim3    = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 
    308309               zlim4    = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 
    309310               xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 
    … …  
    330331               ! ------------------------------ 
    331332               zfuptk = 0.23 * zfvn 
    332                zrpho = 2.24 * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpnph) * rno3 * 15. + rtrn ) 
     333               zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn ) 
    333334               zrass = 1. - 0.2 - zrpho - zfuptk 
    334335               xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 
    335                xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) + 0.13 
     336               xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13 
    336337               xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 
    337338 
    … …  
    344345               ! ------------------------------ 
    345346               zfuptk = 0.35 * zfvn 
    346                zrpho = 2.24 * trb(ji,jj,jk,jppch) / ( trb(ji,jj,jk,jpnpi) * rno3 * 15. + rtrn ) 
     347               zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn ) 
    347348               zrass = 1. - 0.4 - zrpho - zfuptk 
    348349               xqppmax(ji,jj,jk) =  (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 
    349                xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) + 0.13 
     350               xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13 
    350351               xqppmin(ji,jj,jk) = 0.13 
    351352 
    … …  
    354355               zfvn = 2. * fvduptk(ji,jj,jk) 
    355356               sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 
    356                zcoef = trb(ji,jj,jk,jpdia) - MIN(xsizedia, trb(ji,jj,jk,jpdia) ) 
     357               zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) ) 
    357358               sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 
    358359 
    … …  
    360361               ! -------------------- 
    361362               zfuptk = 0.2 * zfvn 
    362                zrpho = 2.24 * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpndi) * rno3 * 15. + rtrn ) 
     363               zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn ) 
    363364               zrass = 1. - 0.2 - zrpho - zfuptk 
    364365               xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 
    365                xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) + 0.13 
     366               xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13 
    366367               xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 
    367368 
    … …  
    375376         DO jj = 1, jpj 
    376377            DO ji = 1, jpi 
    377                zlim1 =  trb(ji,jj,jk,jpnh4) / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) + trb(ji,jj,jk,jpno3)    & 
    378                &        / ( trb(ji,jj,jk,jpno3) + concnno3 ) * ( 1.0 - trb(ji,jj,jk,jpnh4)   & 
    379                &        / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) ) 
    380                zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnpo4 ) 
    381                zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11 )  
    382                ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    383                ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
     378               zlim1 =  tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb)    & 
     379               &        / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb)   & 
     380               &        / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) ) 
     381               zlim2  = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 ) 
     382               zlim3  = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) +  5.E-11 )  
     383               ztem1  = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 
     384               ztem2  = ts(ji,jj,jk,jp_tem,Kmm) - 10. 
    384385               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) )  
    385386 
    386387!               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
    387388               xfracal(ji,jj,jk) = caco3r                 & 
    388                &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., trb(ji,jj,jk,jpphy)*1E6 )   & 
     389               &                   * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 )   & 
    389390                  &                * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
    390391                  &                * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
    … …  
    398399            DO ji = 1, jpi 
    399400               ! denitrification factor computed from O2 levels 
    400                nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    & 
    401                   &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  ) 
     401               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - tr(ji,jj,jk,jpoxy,Kbb) )    & 
     402                  &                                / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) )  ) 
    402403               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
    403404            END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmeso.F90

    r10362 r10975  
    5959CONTAINS 
    6060 
    61    SUBROUTINE p5z_meso( kt, knt ) 
     61   SUBROUTINE p5z_meso( kt, knt, Kbb, Krhs ) 
    6262      !!--------------------------------------------------------------------- 
    6363      !!                     ***  ROUTINE p5z_meso  *** 
    … …  
    6767      !! ** Method  : - ??? 
    6868      !!--------------------------------------------------------------------- 
    69       INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     69      INTEGER, INTENT(in) ::   kt, knt    ! ocean time step 
     70      INTEGER, INTENT(in)  ::  Kbb, Krhs  ! time level indices 
    7071      INTEGER  :: ji, jj, jk 
    7172      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames 
    … …  
    108109         DO jj = 1, jpj 
    109110            DO ji = 1, jpi 
    110                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     111               zcompam   = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 
    111112               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    112113 
    113114               !   Michaelis-Menten mortality rates of mesozooplankton 
    114115               !   --------------------------------------------------- 
    115                zrespz   = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
     116               zrespz   = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) )  & 
    116117               &          + 3. * nitrfac(ji,jj,jk) ) 
    117118 
    … …  
    119120               !   no real reason except that it seems to be more stable and may mimic predation 
    120121               !   --------------------------------------------------------------- 
    121                ztortz   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 
     122               ztortz   = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 
    122123 
    123124               !   Computation of the abundance of the preys 
    124125               !   A threshold can be specified in the namelist 
    125126               !   -------------------------------------------- 
    126                zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    127                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    128                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
    129                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    130                zcompames = MAX( ( trb(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 ) 
     127               zcompadi  = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 
     128               zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 
     129               zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) 
     130               zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 
     131               zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 ) 
    131132 
    132133               !   Mesozooplankton grazing 
    … …  
    136137               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    137138               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    138                zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
     139               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk))  
    139140 
    140141               !   An active switching parameterization is used here. 
    … …  
    161162               !   ------------------------------------------------------ 
    162163               zgrazdc   = zgraze2 * ztmp4 * zdenom 
    163                zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    164                zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn) 
    165                zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
     164               zgrazdn   = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     165               zgrazdp   = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     166               zgrazdf   = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
    166167               zgrazz    = zgraze2 * ztmp5 * zdenom 
    167168               zgrazm    = zgraze2 * ztmp2 * zdenom 
    168169               zgraznc   = zgraze2 * ztmp1 * zdenom 
    169                zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    170                zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn) 
    171                zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
     170               zgraznn   = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     171               zgraznp   = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     172               zgraznf   = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
    172173               zgrazpoc  = zgraze2 * ztmp3 * zdenom 
    173                zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    174                zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    175                zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
     174               zgrazpon  = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     175               zgrazpop  = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     176               zgrazpof  = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    176177 
    177178               !   Mesozooplankton flux feeding on GOC 
    178179               !   ---------------------------------- 
    179180               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    180                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)  & 
     181               &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)  & 
    181182               &           * (1. - nitrfac(ji,jj,jk)) 
    182                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    183                zgrazffng = zgrazffeg * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    184                zgrazffpg = zgrazffeg * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 
     183               zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     184               zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     185               zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
    185186               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    186                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)   & 
     187               &           * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)   & 
    187188               &           * (1. - nitrfac(ji,jj,jk)) 
    188                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    189                zgrazffnp = zgrazffep * trb(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn) 
    190                zgrazffpp = zgrazffep * trb(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn) 
     189               zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     190               zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
     191               zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    191192               ! 
    192193               zgraztotc  = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg 
    … …  
    200201               !   since they are more porous (marine snow instead of fecal pellets) 
    201202               !   ---------------------------------------------------------------- 
    202                zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
     203               zratio    = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
    203204               zratio2   = zratio * zratio 
    204205               zfracc    = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    205                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
     206               &          * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb)          & 
    206207               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    207                zfracfe   = zfracc * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    208                zfracn    = zfracc * trb(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    209                zfracp    = zfracc * trb(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn) 
     208               zfracfe   = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     209               zfracn    = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
     210               zfracp    = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 
    210211 
    211212               zgrazffep = zproport * zgrazffep   ;   zgrazffeg = zproport * zgrazffeg 
    … …  
    296297               !   sinks 
    297298               !   -------------------------------------------------------------- 
    298                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep  
    299                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    300                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
     299               tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep  
     300               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 
     301               tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 
    301302               ! 
    302303               IF( ln_ligand ) THEN 
    303                   tra(ji,jj,jk,jplgw)  = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
     304                  tr(ji,jj,jk,jplgw,Krhs)  = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 
    304305                  zz2ligprod(ji,jj,jk) = zgradoc * ldocz 
    305306               ENDIF 
    306307               ! 
    307                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    308                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    309                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 
    310                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
     308               tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 
     309               tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 
     310               tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 
     311               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 
    311312               zfezoo2(ji,jj,jk)   = zgraref 
    312                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem 
    313                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren 
    314                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc   & 
     313               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem 
     314               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren 
     315               tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc   & 
    315316               &                     - ztortz - zgrazm 
    316                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 
    317                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 
    318                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 
    319                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 
    320                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    321                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 
    322                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 
    323                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 
    324                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    325                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    326                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    327                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    328                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    329  
    330                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc 
     317               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 
     318               tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 
     319               tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 
     320               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 
     321               tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 
     322               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 
     323               tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 
     324               tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 
     325               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     326               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     327               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     328               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     329               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     330 
     331               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc 
    331332               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 
    332333               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    333                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn 
    334                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp 
    335                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc 
     334               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn 
     335               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp 
     336               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc 
    336337               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 
    337338               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 
    338                tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn 
    339                tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp 
    340                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    341                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe 
    342                zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
     339               tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn 
     340               tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp 
     341               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 
     342               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe 
     343               zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 
    343344               zgrazcal = zgrazffeg * (1. - part2) * zfracal 
    344345 
    … …  
    348349               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    349350               zprcaca = part2 * zprcaca 
    350                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
    351                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca ) 
    352                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
     351               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 
     352               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca ) 
     353               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 
    353354            END DO 
    354355         END DO 
    … …  
    379380        WRITE(charout, FMT="('meso')") 
    380381        CALL prt_ctl_trc_info(charout) 
    381         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     382        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    382383      ENDIF 
    383384      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmicro.F90

    r10362 r10975  
    6060CONTAINS 
    6161 
    62    SUBROUTINE p5z_micro( kt, knt ) 
     62   SUBROUTINE p5z_micro( kt, knt, Kbb, Krhs ) 
    6363      !!--------------------------------------------------------------------- 
    6464      !!                     ***  ROUTINE p5z_micro  *** 
    … …  
    7070      INTEGER, INTENT(in) ::  kt  ! ocean time step 
    7171      INTEGER, INTENT(in) ::  knt  
     72      INTEGER, INTENT(in) ::  Kbb, Krhs      ! time level indices 
    7273      ! 
    7374      INTEGER  :: ji, jj, jk 
    … …  
    102103         DO jj = 1, jpj 
    103104            DO ji = 1, jpi 
    104                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     105               zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 
    105106               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    106107 
    107108               !   Michaelis-Menten mortality rates of microzooplankton 
    108109               !   ----------------------------------------------------- 
    109                zrespz = resrat * zfact * ( trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
     110               zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  & 
    110111               &        + 3. * nitrfac(ji,jj,jk) ) 
    111112 
    … …  
    113114               !   no real reason except that it seems to be more stable and may mimic predation. 
    114115               !   ------------------------------------------------------------------------------ 
    115                ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk)) 
     116               ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 
    116117 
    117118               !   Computation of the abundance of the preys 
    118119               !   A threshold can be specified in the namelist 
    119120               !   -------------------------------------------- 
    120                zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    121                zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    122                zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 ) 
    123                zcompapi  = MAX( ( trb(ji,jj,jk,jppic) - xthreshpic ), 0.e0 ) 
    124                zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
     121               zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 
     122               zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 
     123               zcompaz   = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 ) 
     124               zcompapi  = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 ) 
     125               zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 
    125126                
    126127               !   Microzooplankton grazing 
    … …  
    130131               zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 
    131132               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    132                zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))  
     133               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))  
    133134 
    134135               !   An active switching parameterization is used here. 
    … …  
    155156               !   ------------------------------------------------------- 
    156157               zgraznc   = zgraze  * ztmp1  * zdenom 
    157                zgraznn   = zgraznc * trb(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn) 
    158                zgraznp   = zgraznc * trb(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn) 
    159                zgraznf   = zgraznc * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
     158               zgraznn   = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     159               zgraznp   = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     160               zgraznf   = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
    160161               zgrazpc   = zgraze  * ztmp2  * zdenom 
    161                zgrazpn   = zgrazpc * trb(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn) 
    162                zgrazpp   = zgrazpc * trb(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn) 
    163                zgrazpf   = zgrazpc * trb(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn) 
     162               zgrazpn   = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     163               zgrazpp   = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     164               zgrazpf   = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
    164165               zgrazz    = zgraze  * ztmp5   * zdenom 
    165166               zgrazpoc  = zgraze  * ztmp3   * zdenom 
    166                zgrazpon  = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    167                zgrazpop  = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    168                zgrazpof  = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
     167               zgrazpon  = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     168               zgrazpop  = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     169               zgrazpof  = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 
    169170               zgrazdc   = zgraze  * ztmp4  * zdenom 
    170                zgrazdn   = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn) 
    171                zgrazdp   = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn) 
    172                zgrazdf   = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
     171               zgrazdn   = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     172               zgrazdp   = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     173               zgrazdf   = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
    173174               ! 
    174175               zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc 
    … …  
    247248               !   Update of the TRA arrays 
    248249               !   ------------------------ 
    249                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep 
    250                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    251                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
     250               tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 
     251               tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 
     252               tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 
    252253               ! 
    253254               IF( ln_ligand ) THEN  
    254                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
     255                  tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 
    255256                  zzligprod(ji,jj,jk) = zgradoc * ldocz 
    256257               ENDIF 
    257258               ! 
    258                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    259                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    260                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem  
    261                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
     259               tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 
     260               tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 
     261               tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem  
     262               tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 
    262263               zfezoo(ji,jj,jk)    = zgraref 
    263                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 
    264                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc 
    265                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn 
    266                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp 
    267                tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc 
    268                tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn 
    269                tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp 
    270                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc 
    271                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn 
    272                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp 
    273                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    274                tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 
    275                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
    276                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    277                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    278                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    279                tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf 
    280                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf 
    281                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc  
     264               tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 
     265               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 
     266               tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 
     267               tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 
     268               tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc 
     269               tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn 
     270               tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp 
     271               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 
     272               tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 
     273               tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 
     274               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     275               tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     276               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     277               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     278               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 
     279               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 
     280               tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf 
     281               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 
     282               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc  
    282283               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 
    283284               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 
    284                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon 
    285                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop 
    286                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz  + zgrapof - zgrazpof 
     285               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon 
     286               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop 
     287               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz  + zgrapof - zgrazpof 
    287288               ! 
    288289               ! calcite production 
    … …  
    291292               ! 
    292293               zprcaca = part * zprcaca 
    293                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca 
    294                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca     & 
     294               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca 
     295               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca     & 
    295296               &                     + rno3 * zgraren 
    296                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
     297               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
    297298            END DO 
    298299         END DO 
    … …  
    321322         WRITE(charout, FMT="('micro')") 
    322323         CALL prt_ctl_trc_info(charout) 
    323          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     324         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    324325      ENDIF 
    325326      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmort.F90

    r10362 r10975  
    4141CONTAINS 
    4242 
    43    SUBROUTINE p5z_mort( kt ) 
     43   SUBROUTINE p5z_mort( kt, Kbb, Krhs ) 
    4444      !!--------------------------------------------------------------------- 
    4545      !!                     ***  ROUTINE p5z_mort  *** 
    … …  
    5151      !!--------------------------------------------------------------------- 
    5252      INTEGER, INTENT(in) ::   kt ! ocean time step 
    53       !!--------------------------------------------------------------------- 
    54  
    55       CALL p5z_nano            ! nanophytoplankton 
    56       CALL p5z_pico            ! picophytoplankton 
    57       CALL p5z_diat            ! diatoms 
     53      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
     54      !!--------------------------------------------------------------------- 
     55 
     56      CALL p5z_nano( Kbb, Krhs )            ! nanophytoplankton 
     57      CALL p5z_pico( Kbb, Krhs )            ! picophytoplankton 
     58      CALL p5z_diat( Kbb, Krhs )            ! diatoms 
    5859 
    5960   END SUBROUTINE p5z_mort 
    6061 
    6162 
    62    SUBROUTINE p5z_nano 
     63   SUBROUTINE p5z_nano( Kbb, Krhs ) 
    6364      !!--------------------------------------------------------------------- 
    6465      !!                     ***  ROUTINE p5z_nano  *** 
    … …  
    6869      !! ** Method  : - ??? 
    6970      !!--------------------------------------------------------------------- 
     71      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    7072      INTEGER  :: ji, jj, jk 
    7173      REAL(wp) :: zcompaph 
    … …  
    8183         DO jj = 1, jpj 
    8284            DO ji = 1, jpi 
    83                zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-9 ), 0.e0 ) 
     85               zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 
    8486               !   Squared mortality of Phyto similar to a sedimentation term during 
    8587               !   blooms (Doney et al. 1996) 
    8688               !   ----------------------------------------------------------------- 
    87                zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jpphy) 
     89               zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 
    8890 
    8991               !   Phytoplankton linear mortality 
    … …  
    9496               !   Update the arrays TRA which contains the biological sources and sinks 
    9597 
    96                zfactn  = trb(ji,jj,jk,jpnph)/(trb(ji,jj,jk,jpphy)+rtrn) 
    97                zfactp  = trb(ji,jj,jk,jppph)/(trb(ji,jj,jk,jpphy)+rtrn) 
    98                zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 
    99                zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    100                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 
    101                tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn 
    102                tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp 
    103                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 
    104                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
     98               zfactn  = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     99               zfactp  = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     100               zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     101               zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 
     102               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 
     103               tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 
     104               tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 
     105               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 
     106               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 
    105107               zprcaca = xfracal(ji,jj,jk) * zmortp 
    106108               ! 
    107109               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    108110               ! 
    109                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    110                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    111                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    112                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
    113                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn 
    114                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp 
     111               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 
     112               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 
     113               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 
     114               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
     115               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
     116               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
    115117               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
    116                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
     118               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
    117119            END DO 
    118120         END DO 
    … …  
    122124         WRITE(charout, FMT="('nano')") 
    123125         CALL prt_ctl_trc_info(charout) 
    124          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     126         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    125127       ENDIF 
    126128      ! 
    … …  
    130132 
    131133 
    132    SUBROUTINE p5z_pico 
     134   SUBROUTINE p5z_pico( Kbb, Krhs ) 
    133135      !!--------------------------------------------------------------------- 
    134136      !!                     ***  ROUTINE p5z_pico  *** 
    … …  
    138140      !! ** Method  : - ??? 
    139141      !!--------------------------------------------------------------------- 
     142      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    140143      INTEGER  :: ji, jj, jk 
    141144      REAL(wp) :: zcompaph 
    … …  
    150153         DO jj = 1, jpj 
    151154            DO ji = 1, jpi 
    152                zcompaph = MAX( ( trb(ji,jj,jk,jppic) - 1e-9 ), 0.e0 ) 
     155               zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 
    153156               !  Squared mortality of Phyto similar to a sedimentation term during 
    154157               !  blooms (Doney et al. 1996) 
    155158               !  ----------------------------------------------------------------- 
    156                zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * trb(ji,jj,jk,jppic) 
     159               zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 
    157160 
    158161               !     Phytoplankton mortality  
    … …  
    162165               !   Update the arrays TRA which contains the biological sources and sinks 
    163166 
    164                zfactn = trb(ji,jj,jk,jpnpi)/(trb(ji,jj,jk,jppic)+rtrn) 
    165                zfactp = trb(ji,jj,jk,jpppi)/(trb(ji,jj,jk,jppic)+rtrn) 
    166                zfactfe = trb(ji,jj,jk,jppfe)/(trb(ji,jj,jk,jppic)+rtrn) 
    167                zfactch = trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn) 
    168                tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp 
    169                tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn 
    170                tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp 
    171                tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch 
    172                tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe 
    173                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
    174                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn 
    175                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp 
    176                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
     167               zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     168               zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     169               zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     170               zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 
     171               tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 
     172               tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 
     173               tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 
     174               tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 
     175               tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 
     176               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 
     177               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 
     178               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 
     179               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 
    177180               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 
    178181            END DO 
    … …  
    183186         WRITE(charout, FMT="('pico')") 
    184187         CALL prt_ctl_trc_info(charout) 
    185          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     188         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    186189       ENDIF 
    187190      ! 
    … …  
    191194 
    192195 
    193    SUBROUTINE p5z_diat 
     196   SUBROUTINE p5z_diat( Kbb, Krhs ) 
    194197      !!--------------------------------------------------------------------- 
    195198      !!                     ***  ROUTINE p5z_diat  *** 
    … …  
    199202      !! ** Method  : - ??? 
    200203      !!--------------------------------------------------------------------- 
     204      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices 
    201205      INTEGER  ::  ji, jj, jk 
    202206      REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi 
    … …  
    213217            DO ji = 1, jpi 
    214218 
    215                zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1E-9), 0. ) 
     219               zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 
    216220 
    217221               !   Aggregation term for diatoms is increased in case of nutrient 
    … …  
    223227               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    224228               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    225                zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
     229               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 
    226230 
    227231               !  Phytoplankton linear mortality  
    … …  
    230234               zmortp2 = zrespp2 + ztortp2 
    231235 
    232                !   Update the arrays tra which contains the biological sources and sinks 
     236               !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 
    233237               !   --------------------------------------------------------------------- 
    234                zfactn  = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    235                zfactp  = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    236                zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    237                zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    238                zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    239                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2  
    240                tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn 
    241                tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp 
    242                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 
    243                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 
    244                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 
    245                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 
    246                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2  
    247                tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn 
    248                tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp 
    249                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe 
    250                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2 
    251                tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn 
    252                tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp 
    253                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe 
     238               zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     239               zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     240               zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     241               zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     242               zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     243               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2  
     244               tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 
     245               tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 
     246               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 
     247               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 
     248               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 
     249               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 
     250               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2  
     251               tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 
     252               tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 
     253               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 
     254               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 
     255               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 
     256               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 
     257               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 
    254258               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2 
    255259               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2 
    … …  
    261265         WRITE(charout, FMT="('diat')") 
    262266         CALL prt_ctl_trc_info(charout) 
    263          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     267         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    264268      ENDIF 
    265269      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zprod.F90

    r10425 r10975  
    5757CONTAINS 
    5858 
    59    SUBROUTINE p5z_prod( kt , knt ) 
     59   SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs ) 
    6060      !!--------------------------------------------------------------------- 
    6161      !!                     ***  ROUTINE p5z_prod  *** 
    … …  
    6868      ! 
    6969      INTEGER, INTENT(in) :: kt, knt 
     70      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs      ! time level indices 
    7071      ! 
    7172      INTEGER  ::   ji, jj, jk 
    … …  
    136137               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    137138                  zval = MAX( 1., zstrn(ji,jj) ) 
    138                   IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     139                  IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 
    139140                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
    140141                  ENDIF 
    … …  
    160161               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    161162                  ! Computation of the P-I slope for nanos and diatoms 
    162                   ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     163                  ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 
    163164                  zadap       = xadap * ztn / ( 2.+ ztn ) 
    164165                  ! 
    165                   zpislopeadn(ji,jj,jk) = pislopen * trb(ji,jj,jk,jpnch)    & 
    166                   &                       /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
     166                  zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    & 
     167                  &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 
    167168                  zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   & 
    168                   &                       * trb(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn) 
    169                   zpislopeadd(ji,jj,jk) = pisloped * trb(ji,jj,jk,jpdch)    & 
    170                      &                    /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
     169                  &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 
     170                  zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    & 
     171                     &                    /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 
    171172                  ! 
    172173                  zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    … …  
    203204                  !    Si/C is arbitrariliy increased for very high Si concentrations 
    204205                  !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    205                   zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
     206                  zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 
    206207                  zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    207208                  zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    208                   zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
     209                  zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 
    209210                  IF (gphit(ji,jj) < -30 ) THEN 
    210211                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    … …  
    236237               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    237238                  !  production terms for nanophyto. 
    238                   zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
     239                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    239240                  ! 
    240                   zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    241                   zratiop = trb(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    242                   zratiof = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    243                   zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2 
     241                  zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     242                  zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     243                  zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 
     244                  zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 
    244245                  ! Uptake of nitrogen 
    245246                  zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )  
    … …  
    273274               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    274275                  !  production terms for picophyto. 
    275                   zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * trb(ji,jj,jk,jppic) * rfact2 
     276                  zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 
    276277                  ! 
    277                   zration = trb(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    278                   zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    279                   zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    280                   zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2 
     278                  zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     279                  zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     280                  zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 
     281                  zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 
    281282                  ! Uptake of nitrogen 
    282283                  zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
    … …  
    310311               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    311312                  !  production terms for diatomees 
    312                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
     313                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    313314                  ! Computation of the respiration term according to pahlow  
    314315                  ! & oschlies (2013) 
    315316                  ! 
    316                   zration = trb(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    317                   zratiop = trb(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    318                   zratiof = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    319                   zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2 
     317                  zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     318                  zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     319                  zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 
     320                  zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 
    320321                  ! Uptake of nitrogen 
    321322                  zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
    … …  
    350351                  znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    351352                  zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 
    352                   thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
     353                  thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
    353354                  &               * (1. - 1.14 / 43.4 * 20.)) 
    354355                  zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 
    … …  
    357358                  zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    358359                  zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 
    359                   thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
     360                  thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
    360361                  &               * (1. - 1.14 / 43.4 * 20.)) 
    361362                  zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 
    … …  
    364365                  zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
    365366                  zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 
    366                   thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem)))   & 
     367                  thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   & 
    367368                  &               * (1. - 1.14 / 43.4 * 20.)) 
    368369                  zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 
    369370                  zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 
    370371                  !   Update the arrays TRA which contain the Chla sources and sinks 
    371                   tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
    372                   tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
    373                   tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp 
     372                  tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 
     373                  tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 
     374                  tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 
    374375               ENDIF 
    375376            END DO 
    … …  
    386387              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    387388              &          + excretp * zprorcap(ji,jj,jk) 
    388               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
     389              tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  & 
    389390              &                     - zpropo4p(ji,jj,jk) 
    390               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
     391              tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  & 
    391392              &                     - zpronewp(ji,jj,jk) 
    392               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
     393              tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  & 
    393394              &                     - zproregp(ji,jj,jk) 
    394               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn    & 
     395              tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn    & 
    395396                 &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   & 
    396397                 &                  - zrespn(ji,jj,jk)  
    397               zcroissn(ji,jj,jk) = tra(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn) 
    398               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn 
    399               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn   & 
     398              zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 
     399              tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 
     400              tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   & 
    400401              &                     + zprodopn(ji,jj,jk) * texcretn 
    401               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
    402               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp     & 
     402              tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 
     403              tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp     & 
    403404                 &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   & 
    404405                 &                  - zrespp(ji,jj,jk)  
    405               zcroissp(ji,jj,jk) = tra(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn) 
    406               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp 
    407               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp   & 
     406              zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 
     407              tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 
     408              tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   & 
    408409              &                     + zprodopp(ji,jj,jk) * texcretp 
    409               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp 
    410               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd   & 
     410              tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 
     411              tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd   & 
    411412                 &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   & 
    412413                 &                  - zrespd(ji,jj,jk)  
    413               zcroissd(ji,jj,jk) = tra(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn) 
    414               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd 
    415               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd   & 
     414              zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 
     415              tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 
     416              tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   & 
    416417              &                     + zprodopd(ji,jj,jk) * texcretd 
    417               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
    418               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
    419               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
     418              tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 
     419              tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     420              tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  & 
    420421              &                     + excretp * zprorcap(ji,jj,jk) 
    421               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot   & 
     422              tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   & 
    422423              &                     + excretp * zproptot 
    423               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
     424              tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   & 
    424425              &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     & 
    425426              &    - texcretp * zprodopp(ji,jj,jk) 
    426               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
     427              tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   & 
    427428                 &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           & 
    428429                 &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   & 
    429430                 &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 
    430431              zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    431               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
    432               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    433               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
     432              tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 
     433              tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     434              tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
    434435              &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   & 
    435436              &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   & 
    436437              &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  & 
    437438              &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)  
    438               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
     439              tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  & 
    439440              &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     & 
    440441              &                     + zproregp(ji,jj,jk) )  
    … …  
    449450                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 
    450451                 zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    451                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     452                 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
    452453                 zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    453454                 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet 
    … …  
    556557         WRITE(charout, FMT="('prod')") 
    557558         CALL prt_ctl_trc_info(charout) 
    558          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     559         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
    559560      ENDIF 
    560561      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/oce_sed.F90

    r10362 r10975  
    1313   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    1414   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    15    USE dom_oce , ONLY :   e3t_n     =>   e3t_n          !: latitude  of t-point (degre) 
     15   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
    1616   USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m) 
    1717   USE dom_oce , ONLY :   gdepw_0   =>   gdepw_0        !: reference depth of t-points (m) 
    … …  
    2626   !                                !: that may have been run with different time steps. 
    2727 
    28    USE oce     , ONLY :  tsn        =>   tsn             !: pot. temperature (celsius) and salinity (psu) 
    29    USE trc     , ONLY :  trb        =>   trb             !: pot. temperature (celsius) and salinity (psu) 
     28   USE oce     , ONLY :   ts        =>   ts              !: pot. temperature (celsius) and salinity (psu) 
     29   USE trc     , ONLY :   tr        =>   tr              !: pot. temperature (celsius) and salinity (psu) 
    3030 
    3131   USE sms_pisces, ONLY : wsbio4    =>   wsbio4          !: sinking flux for POC 
    3232   USE sms_pisces, ONLY : wsbio3    =>   wsbio3          !: sinking flux for GOC 
    33    USE sms_pisces, ONLY : wsbio2    =>   wsbio2           !: sinking flux for calcite 
     33   USE sms_pisces, ONLY : wsbio2    =>   wsbio2          !: sinking flux for calcite 
    3434   USE sms_pisces, ONLY : wsbio     =>   wsbio           !: sinking flux for calcite 
    3535   USE sms_pisces, ONLY : ln_p5z    =>   ln_p5z          !: PISCES-QUOTA flag 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/seddta.F90

    r10362 r10975  
    2929   !!--------------------------------------------------------------------------- 
    3030 
    31    SUBROUTINE sed_dta( kt ) 
     31   SUBROUTINE sed_dta( kt, Kbb, Kmm ) 
    3232      !!---------------------------------------------------------------------- 
    3333      !!                   ***  ROUTINE sed_dta  *** 
    … …  
    4343 
    4444      !! Arguments 
    45       INTEGER, INTENT(in) ::  kt    ! time-step 
     45      INTEGER, INTENT(in) ::  kt         ! time-step 
     46      INTEGER, INTENT(in) ::  Kbb, Kmm   ! time level indices 
    4647 
    4748      !! * Local declarations 
    … …  
    103104            DO ji = 1, jpi 
    104105               ikt = mbkt(ji,jj) 
    105                zdep = e3t_n(ji,jj,ikt) / r2dttrc 
     106               zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 
    106107               zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 
    107108               zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) 
    … …  
    115116            ikt = mbkt(ji,jj) 
    116117            IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    117                trc_data(ji,jj,1)   = trb(ji,jj,ikt,jpsil) 
    118                trc_data(ji,jj,2)   = trb(ji,jj,ikt,jpoxy) 
    119                trc_data(ji,jj,3)   = trb(ji,jj,ikt,jpdic) 
    120                trc_data(ji,jj,4)   = trb(ji,jj,ikt,jpno3) / 7.625 
    121                trc_data(ji,jj,5)   = trb(ji,jj,ikt,jppo4) / 122. 
    122                trc_data(ji,jj,6)   = trb(ji,jj,ikt,jptal) 
    123                trc_data(ji,jj,7)   = trb(ji,jj,ikt,jpnh4) / 7.625 
     118               trc_data(ji,jj,1)   = tr(ji,jj,ikt,jpsil,Kbb) 
     119               trc_data(ji,jj,2)   = tr(ji,jj,ikt,jpoxy,Kbb) 
     120               trc_data(ji,jj,3)   = tr(ji,jj,ikt,jpdic,Kbb) 
     121               trc_data(ji,jj,4)   = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 
     122               trc_data(ji,jj,5)   = tr(ji,jj,ikt,jppo4,Kbb) / 122. 
     123               trc_data(ji,jj,6)   = tr(ji,jj,ikt,jptal,Kbb) 
     124               trc_data(ji,jj,7)   = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 
    124125               trc_data(ji,jj,8)   = 0.0 
    125126               trc_data(ji,jj,9)   = 28.0E-3 
    126                trc_data(ji,jj,10)  = trb(ji,jj,ikt,jpfer) 
    127                trc_data(ji,jj,11 ) = MIN(trb(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3 
    128                trc_data(ji,jj,12 ) = MIN(trb(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3 
    129                trc_data(ji,jj,13 ) = MIN(trb(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3 
    130                trc_data(ji,jj,14)  = MIN(trb(ji,jj,ikt,jpcal), 1E-4) * zwsbio4(ji,jj) * 1E3 
    131                trc_data(ji,jj,15)  = tsn(ji,jj,ikt,jp_tem) 
    132                trc_data(ji,jj,16)  = tsn(ji,jj,ikt,jp_sal) 
    133                trc_data(ji,jj,17 ) = ( trb(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe)  & 
     127               trc_data(ji,jj,10)  = tr(ji,jj,ikt,jpfer,Kbb) 
     128               trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     129               trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 
     130               trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     131               trc_data(ji,jj,14)  = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 
     132               trc_data(ji,jj,15)  = ts(ji,jj,ikt,jp_tem,Kmm) 
     133               trc_data(ji,jj,16)  = ts(ji,jj,ikt,jp_sal,Kmm) 
     134               trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb)  & 
    134135               &                     * zwsbio4(ji,jj)  ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 
    135136               trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedinitrc.F90

    r10225 r10975  
    3333 
    3434 
    35    SUBROUTINE sed_initrc 
     35   SUBROUTINE sed_initrc( Kbb, Kmm ) 
    3636      !!---------------------------------------------------------------------- 
    3737      !!                   ***  ROUTINE sed_init  *** 
    … …  
    5050      !!        !  06-07  (C. Ethe)  Re-organization 
    5151      !!---------------------------------------------------------------------- 
     52      INTEGER, INTENT(in)  ::  Kbb, Kmm      ! time level indices 
    5253      INTEGER :: ji, jj, ikt 
    5354      !!---------------------------------------------------------------------- 
    … …  
    6566      ! ( only clay or reading restart file ) 
    6667      !--------------------------------------- 
    67       CALL sed_init_data 
     68      CALL sed_init_data( Kbb, Kmm ) 
    6869 
    6970 
    … …  
    7475 
    7576 
    76    SUBROUTINE sed_init_data 
     77   SUBROUTINE sed_init_data( Kbb, Kmm ) 
    7778      !!---------------------------------------------------------------------- 
    7879      !!                   ***  ROUTINE sed_init_data  *** 
    … …  
    8586      !!        !  06-07  (C. Ethe)  original 
    8687      !!---------------------------------------------------------------------- 
     88      INTEGER, INTENT(in)  ::  Kbb, Kmm      ! time level indices 
    8789  
    8890      ! local variables 
    … …  
    128130 
    129131      ! Load initial Pisces Data for bot. wat. Chem and fluxes 
    130       CALL sed_dta ( nitsed000 )  
     132      CALL sed_dta ( nitsed000, Kbb, Kmm )  
    131133 
    132134      ! Initialization of chemical constants 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedmodel.F90

    r10963 r10975  
    1616CONTAINS 
    1717 
    18    SUBROUTINE sed_model ( kt, Kmm ) 
     18   SUBROUTINE sed_model ( kt, Kbb, Kmm, Krhs ) 
    1919      !!--------------------------------------------------------------------- 
    2020      !!                  ***  ROUTINE sed_model  *** 
    … …  
    2929      !!        !  07-02 (C. Ethe)  Original 
    3030      !!---------------------------------------------------------------------- 
    31       INTEGER, INTENT(in) ::   kt       ! number of iteration 
    32       INTEGER, INTENT(in) ::   Kmm      ! time level indices 
     31      INTEGER, INTENT(in) ::   kt               ! number of iteration 
     32      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! time level indices 
    3333 
    3434 
    3535      IF( ln_timing )  CALL timing_start('sed_model') 
    3636 
    37       IF( kt == nittrc000 ) CALL sed_initrc       ! Initialization of sediment model 
    38                             CALL sed_stp( kt, Kmm )  ! Time stepping of Sediment model 
     37      IF( kt == nittrc000 ) CALL sed_initrc( Kbb, Kmm )         ! Initialization of sediment model 
     38                            CALL sed_stp( kt, Kbb, Kmm, Krhs )  ! Time stepping of Sediment model 
    3939 
    4040      IF( ln_timing )  CALL timing_stop('sed_model') 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedsfc.F90

    r10222 r10975  
    1414CONTAINS 
    1515 
    16    SUBROUTINE sed_sfc( kt ) 
     16   SUBROUTINE sed_sfc( kt, Kbb ) 
    1717      !!--------------------------------------------------------------------- 
    1818      !!                  ***  ROUTINE sed_sfc *** 
    … …  
    2626      !!* Arguments 
    2727      INTEGER, INTENT(in) ::  kt              ! time step 
     28      INTEGER, INTENT(in) ::  Kbb             ! time index 
    2829 
    2930      ! * local variables 
    … …  
    4950            ikt = mbkt(ji,jj) 
    5051            IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    51                trb(ji,jj,ikt,jptal) = trc_data(ji,jj,1) 
    52                trb(ji,jj,ikt,jpdic) = trc_data(ji,jj,2) 
    53                trb(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.625 
    54                trb(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122. 
    55                trb(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5) 
    56                trb(ji,jj,ikt,jpsil) = trc_data(ji,jj,6) 
    57                trb(ji,jj,ikt,jpnh4) = trc_data(ji,jj,7) * 7.625 
    58                trb(ji,jj,ikt,jpfer) = trc_data(ji,jj,8) 
     52               tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 
     53               tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 
     54               tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 
     55               tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 
     56               tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 
     57               tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 
     58               tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 
     59               tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 
    5960            ENDIF 
    6061         ENDDO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedstp.F90

    r10963 r10975  
    2929CONTAINS 
    3030 
    31    SUBROUTINE sed_stp ( kt, Kmm ) 
     31   SUBROUTINE sed_stp ( kt, Kbb, Kmm, Krhs ) 
    3232      !!--------------------------------------------------------------------- 
    3333      !!                  ***  ROUTINE sed_stp  *** 
    … …  
    4444      !!        !  06-04 (C. Ethe)  Re-organization 
    4545      !!---------------------------------------------------------------------- 
    46       INTEGER, INTENT(in) ::   kt       ! number of iteration 
    47       INTEGER, INTENT(in) ::   Kmm      ! time level indices 
     46      INTEGER, INTENT(in) ::   kt                ! number of iteration 
     47      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs    ! time level indices 
    4848      INTEGER :: ji,jk,js,jn,jw 
    4949      !!---------------------------------------------------------------------- 
    … …  
    5353      IF( lrst_sed )            CALL sed_rst_cal  ( kt, 'WRITE' )   ! calenda 
    5454 
    55       IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt, Kmm ) 
     55      IF(ln_sediment_offline)   CALL trc_dmp_sed  ( kt, Kbb, Kmm, Krhs ) 
    5656 
    5757      dtsed  = r2dttrc 
    5858!      dtsed2 = dtsed 
    5959      IF (kt /= nitsed000) THEN 
    60          CALL sed_dta( kt )       ! Load  Data for bot. wat. Chem and fluxes 
     60         CALL sed_dta( kt, Kbb, Kmm )       ! Load  Data for bot. wat. Chem and fluxes 
    6161      ENDIF 
    6262 
    … …  
    8181         CALL sed_mbc( kt )         ! cumulation for mass balance calculation 
    8282 
    83          IF (ln_sed_2way) CALL sed_sfc( kt )         ! Give back new bottom wat chem to tracer model 
     83         IF (ln_sed_2way) CALL sed_sfc( kt, Kbb )         ! Give back new bottom wat chem to tracer model 
    8484      ENDIF 
    8585      CALL sed_wri( kt )         ! outputs 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/trcdmp_sed.F90

    r10963 r10975  
    5454 
    5555 
    56    SUBROUTINE trc_dmp_sed( kt, Kmm ) 
     56   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) 
    5757      !!---------------------------------------------------------------------- 
    5858      !!                   ***  ROUTINE trc_dmp_sed  *** 
    … …  
    6464      !! ** Method  :   Newtonian damping towards trdta computed  
    6565      !!      and add to the general tracer trends: 
    66       !!                     trn = tra + restotr * (trdta - trb) 
     66      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 
    6767      !!         The trend is computed either throughout the water column 
    6868      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 
    6969      !!      below the well mixed layer (nlmdmptr=2) 
    7070      !! 
    71       !! ** Action  : - update the tracer trends tra with the newtonian  
     71      !! ** Action  : - update the tracer trends tr(Krhs) with the newtonian  
    7272      !!                damping trends. 
    7373      !!              - save the trends ('key_trdmxl_trc') 
    7474      !!---------------------------------------------------------------------- 
    75       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    76       INTEGER, INTENT(in) ::   Kmm  ! time level index 
     75      INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
     76      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level index 
    7777      ! 
    7878      INTEGER ::   ji, jj, jk, jn, jl, ikt   ! dummy loop indices 
    … …  
    9696                  DO ji = 1, jpi   ! vector opt. 
    9797                     ikt = mbkt(ji,jj) 
    98                      trb(ji,jj,ikt,jn) = ztrcdta(ji,jj,ikt) + ( trb(ji,jj,ikt,jn) -  ztrcdta(ji,jj,ikt) )     & 
     98                     tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) -  ztrcdta(ji,jj,ikt) )     & 
    9999                     &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
    100100                  END DO 
    … …  
    110110         WRITE(charout, FMT="('dmp ')") 
    111111         CALL prt_ctl_trc_info(charout) 
    112          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     112         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    113113      ENDIF 
    114114      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/trcini_pisces.F90

    r10425 r10975  
    3232CONTAINS 
    3333 
    34    SUBROUTINE trc_ini_pisces 
     34   SUBROUTINE trc_ini_pisces( Kmm ) 
    3535      !!---------------------------------------------------------------------- 
    3636      !!                   ***  ROUTINE trc_ini_pisces *** 
    … …  
    3838      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    3939      !!---------------------------------------------------------------------- 
     40      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    4041      ! 
    4142      CALL trc_nam_pisces 
    4243      ! 
    43       IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini   !  PISCES 
    44       ELSE                           ;   CALL p2z_ini   !  LOBSTER 
     44      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini( Kmm )   !  PISCES 
     45      ELSE                           ;   CALL p2z_ini( Kmm )   !  LOBSTER 
    4546      ENDIF 
    4647 
    … …  
    4849 
    4950 
    50    SUBROUTINE p4z_ini 
     51   SUBROUTINE p4z_ini( Kmm ) 
    5152      !!---------------------------------------------------------------------- 
    5253      !!                   ***  ROUTINE p4z_ini *** 
    … …  
    7778      USE p5zmort         !  Mortality terms for phytoplankton 
    7879      ! 
     80      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    7981      REAL(wp), SAVE ::   sco2   =  2.312e-3_wp 
    8082      REAL(wp), SAVE ::   alka0  =  2.426e-3_wp 
    … …  
    189191      !-------------------------------------------------------------- 
    190192      IF( .NOT.ln_rsttr ) THEN   
    191          trn(:,:,:,jpdic) = sco2 
    192          trn(:,:,:,jpdoc) = bioma0 
    193          trn(:,:,:,jptal) = alka0 
    194          trn(:,:,:,jpoxy) = oxyg0 
    195          trn(:,:,:,jpcal) = bioma0 
    196          trn(:,:,:,jppo4) = po4 / po4r 
    197          trn(:,:,:,jppoc) = bioma0 
    198          trn(:,:,:,jpgoc) = bioma0 
    199          trn(:,:,:,jpbfe) = bioma0 * 5.e-6 
    200          trn(:,:,:,jpsil) = silic1 
    201          trn(:,:,:,jpdsi) = bioma0 * 0.15 
    202          trn(:,:,:,jpgsi) = bioma0 * 5.e-6 
    203          trn(:,:,:,jpphy) = bioma0 
    204          trn(:,:,:,jpdia) = bioma0 
    205          trn(:,:,:,jpzoo) = bioma0 
    206          trn(:,:,:,jpmes) = bioma0 
    207          trn(:,:,:,jpfer) = 0.6E-9 
    208          trn(:,:,:,jpsfe) = bioma0 * 5.e-6 
    209          trn(:,:,:,jpdfe) = bioma0 * 5.e-6 
    210          trn(:,:,:,jpnfe) = bioma0 * 5.e-6 
    211          trn(:,:,:,jpnch) = bioma0 * 12. / 55. 
    212          trn(:,:,:,jpdch) = bioma0 * 12. / 55. 
    213          trn(:,:,:,jpno3) = no3 
    214          trn(:,:,:,jpnh4) = bioma0 
     193         tr(:,:,:,jpdic,Kmm) = sco2 
     194         tr(:,:,:,jpdoc,Kmm) = bioma0 
     195         tr(:,:,:,jptal,Kmm) = alka0 
     196         tr(:,:,:,jpoxy,Kmm) = oxyg0 
     197         tr(:,:,:,jpcal,Kmm) = bioma0 
     198         tr(:,:,:,jppo4,Kmm) = po4 / po4r 
     199         tr(:,:,:,jppoc,Kmm) = bioma0 
     200         tr(:,:,:,jpgoc,Kmm) = bioma0 
     201         tr(:,:,:,jpbfe,Kmm) = bioma0 * 5.e-6 
     202         tr(:,:,:,jpsil,Kmm) = silic1 
     203         tr(:,:,:,jpdsi,Kmm) = bioma0 * 0.15 
     204         tr(:,:,:,jpgsi,Kmm) = bioma0 * 5.e-6 
     205         tr(:,:,:,jpphy,Kmm) = bioma0 
     206         tr(:,:,:,jpdia,Kmm) = bioma0 
     207         tr(:,:,:,jpzoo,Kmm) = bioma0 
     208         tr(:,:,:,jpmes,Kmm) = bioma0 
     209         tr(:,:,:,jpfer,Kmm) = 0.6E-9 
     210         tr(:,:,:,jpsfe,Kmm) = bioma0 * 5.e-6 
     211         tr(:,:,:,jpdfe,Kmm) = bioma0 * 5.e-6 
     212         tr(:,:,:,jpnfe,Kmm) = bioma0 * 5.e-6 
     213         tr(:,:,:,jpnch,Kmm) = bioma0 * 12. / 55. 
     214         tr(:,:,:,jpdch,Kmm) = bioma0 * 12. / 55. 
     215         tr(:,:,:,jpno3,Kmm) = no3 
     216         tr(:,:,:,jpnh4,Kmm) = bioma0 
    215217         IF( ln_ligand) THEN 
    216             trn(:,:,:,jplgw) = 0.6E-9 
     218            tr(:,:,:,jplgw,Kmm) = 0.6E-9 
    217219         ENDIF 
    218220         IF( ln_p5z ) THEN 
    219             trn(:,:,:,jpdon) = bioma0 
    220             trn(:,:,:,jpdop) = bioma0 
    221             trn(:,:,:,jppon) = bioma0 
    222             trn(:,:,:,jppop) = bioma0 
    223             trn(:,:,:,jpgon) = bioma0 
    224             trn(:,:,:,jpgop) = bioma0 
    225             trn(:,:,:,jpnph) = bioma0 
    226             trn(:,:,:,jppph) = bioma0 
    227             trn(:,:,:,jppic) = bioma0 
    228             trn(:,:,:,jpnpi) = bioma0 
    229             trn(:,:,:,jpppi) = bioma0 
    230             trn(:,:,:,jpndi) = bioma0 
    231             trn(:,:,:,jppdi) = bioma0 
    232             trn(:,:,:,jppfe) = bioma0 * 5.e-6 
    233             trn(:,:,:,jppch) = bioma0 * 12. / 55. 
     221            tr(:,:,:,jpdon,Kmm) = bioma0 
     222            tr(:,:,:,jpdop,Kmm) = bioma0 
     223            tr(:,:,:,jppon,Kmm) = bioma0 
     224            tr(:,:,:,jppop,Kmm) = bioma0 
     225            tr(:,:,:,jpgon,Kmm) = bioma0 
     226            tr(:,:,:,jpgop,Kmm) = bioma0 
     227            tr(:,:,:,jpnph,Kmm) = bioma0 
     228            tr(:,:,:,jppph,Kmm) = bioma0 
     229            tr(:,:,:,jppic,Kmm) = bioma0 
     230            tr(:,:,:,jpnpi,Kmm) = bioma0 
     231            tr(:,:,:,jpppi,Kmm) = bioma0 
     232            tr(:,:,:,jpndi,Kmm) = bioma0 
     233            tr(:,:,:,jppdi,Kmm) = bioma0 
     234            tr(:,:,:,jppfe,Kmm) = bioma0 * 5.e-6 
     235            tr(:,:,:,jppch,Kmm) = bioma0 * 12. / 55. 
    234236         ENDIF 
    235237         ! initialize the half saturation constant for silicate 
    … …  
    254256         CALL p5z_prod_init      !  phytoplankton growth rate over the global ocean. 
    255257      ENDIF 
    256       CALL p4z_sbc_init          !  boundary conditions 
     258      CALL p4z_sbc_init( Kmm )   !  boundary conditions 
    257259      CALL p4z_fechem_init       !  Iron chemistry 
    258260      CALL p4z_rem_init          !  remineralisation 
    … …  
    288290 
    289291 
    290    SUBROUTINE p2z_ini 
     292   SUBROUTINE p2z_ini( Kmm ) 
    291293      !!---------------------------------------------------------------------- 
    292294      !!                   ***  ROUTINE p2z_ini *** 
    … …  
    300302      USE p2zsed 
    301303      ! 
     304      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    302305      INTEGER  ::  ji, jj, jk, jn, ierr 
    303306      CHARACTER(len = 10)  ::  cltra 
    … …  
    338341      ! ---------------------- 
    339342      IF( .NOT. ln_rsttr ) THEN             ! in case of  no restart  
    340          trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:) 
    341          trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:) 
    342          trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:) 
    343          trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 
    344          trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 
    345          WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:) 
    346          ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 
     343         tr(:,:,:,jpdet,Kmm) = 0.1 * tmask(:,:,:) 
     344         tr(:,:,:,jpzoo,Kmm) = 0.1 * tmask(:,:,:) 
     345         tr(:,:,:,jpnh4,Kmm) = 0.1 * tmask(:,:,:) 
     346         tr(:,:,:,jpphy,Kmm) = 0.1 * tmask(:,:,:) 
     347         tr(:,:,:,jpdom,Kmm) = 1.0 * tmask(:,:,:) 
     348         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  tr(:,:,:,jpno3,Kmm) = 2._wp * tmask(:,:,:) 
     349         ELSE WHERE                      ;  tr(:,:,:,jpno3,Kmm) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 
    347350         END WHERE                        
    348351      ENDIF 
    349       !                       !  Namelist read 
    350       CALL p2z_opt_init       !  Optics parameters 
    351       CALL p2z_sed_init       !  sedimentation 
    352       CALL p2z_bio_init       !  biology 
    353       CALL p2z_exp_init      !  export  
     352      !                        !  Namelist read 
     353      CALL p2z_opt_init        !  Optics parameters 
     354      CALL p2z_sed_init        !  sedimentation 
     355      CALL p2z_bio_init        !  biology 
     356      CALL p2z_exp_init( Kmm ) !  export  
    354357      ! 
    355358      IF(lwp) WRITE(numout,*)  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/trcsms_pisces.F90

    r10966 r10975  
    2525CONTAINS 
    2626 
    27    SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm ) 
     27   SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm, Krhs ) 
    2828      !!--------------------------------------------------------------------- 
    2929      !!                     ***  ROUTINE trc_sms_pisces  *** 
    … …  
    3434      !!--------------------------------------------------------------------- 
    3535      ! 
    36       INTEGER, INTENT( in ) ::   kt           ! ocean time-step index       
    37       INTEGER, INTENT( in ) ::   Kbb, Kmm     ! time level index 
     36      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index       
     37      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs   ! time level index 
    3838      !!--------------------------------------------------------------------- 
    3939      ! 
    40       IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt, Kbb, Kmm )   !  PISCES 
    41       ELSE                           ;   CALL p2z_sms( kt,      Kmm )   !  LOBSTER 
     40      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt, Kbb, Kmm, Krhs )   !  PISCES 
     41      ELSE                           ;   CALL p2z_sms( kt,      Kmm, Krhs )   !  LOBSTER 
    4242      ENDIF 
    4343 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/trcwri_pisces.F90

    r10069 r10975  
    2626CONTAINS 
    2727 
    28    SUBROUTINE trc_wri_pisces 
     28   SUBROUTINE trc_wri_pisces( Kmm ) 
    2929      !!--------------------------------------------------------------------- 
    3030      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    3232      !! ** Purpose :   output passive tracers fields  
    3333      !!--------------------------------------------------------------------- 
     34      INTEGER, INTENT(in)          :: Kmm      ! time level indices 
    3435      CHARACTER (len=20)           :: cltra 
    3536      REAL(wp)                     :: zfact 
    … …  
    4344         DO jn = jp_pcs0, jp_pcs1 
    4445            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    45             CALL iom_put( cltra, trn(:,:,:,jn) ) 
     46            CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 
    4647         END DO 
    4748      ELSE 
    … …  
    5152            IF( jn == jppo4  )                 zfact = po4r * 1.0e+6 
    5253            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    53             IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 
     54            IF( iom_use( cltra ) )  CALL iom_put( cltra, tr(:,:,:,jn,Kmm) * zfact ) 
    5455         END DO 
    5556 
    … …  
    5758            zdic(:,:) = 0. 
    5859            DO jk = 1, jpkm1 
    59                zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
     60               zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12. 
    6061            ENDDO 
    6162            CALL iom_put( 'INTDIC', zdic )      
    … …  
    6364         ! 
    6465         IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth  
    65             zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 
    66             zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1) 
     66            zo2min   (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 
     67            zdepo2min(:,:) = gdepw(:,:,1,Kmm)   * tmask(:,:,1) 
    6768            DO jk = 2, jpkm1 
    6869               DO jj = 1, jpj 
    6970                  DO ji = 1, jpi 
    7071                     IF( tmask(ji,jj,jk) == 1 ) then 
    71                         IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 
    72                            zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy) 
    73                            zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 
     72                        IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 
     73                           zo2min   (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 
     74                           zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 
    7475                        ENDIF 
    7576                     ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcini.F90

    r10963 r10975  
    7575      IF(lwp) WRITE(numout,*) 
    7676      ! 
    77       CALL trc_ini_sms   ! SMS 
    78       CALL trc_ini_trp   ! passive tracers transport 
    79       CALL trc_ice_ini   ! Tracers in sea ice 
     77      CALL trc_ini_sms( Kmm )   ! SMS 
     78      CALL trc_ini_trp          ! passive tracers transport 
     79      CALL trc_ice_ini          ! Tracers in sea ice 
    8080      ! 
    8181      IF( lwm .AND. sn_cfctl%l_trcstat ) THEN 
    … …  
    159159 
    160160 
    161    SUBROUTINE trc_ini_sms 
     161   SUBROUTINE trc_ini_sms( Kmm ) 
    162162      !!---------------------------------------------------------------------- 
    163163      !!                     ***  ROUTINE trc_ini_sms  *** 
    … …  
    170170      USE trcini_my_trc  ! MY_TRC   initialisation 
    171171      ! 
     172      INTEGER, INTENT(in) ::   Kmm ! time level indices 
    172173      INTEGER :: jn 
    173174      !!---------------------------------------------------------------------- 
    … …  
    184185      END DO 
    185186      !     
    186       IF( ln_pisces      )   CALL trc_ini_pisces     !  PISCES model 
    187       IF( ln_my_trc      )   CALL trc_ini_my_trc     !  MY_TRC model 
    188       IF( ll_cfc         )   CALL trc_ini_cfc        !  CFC's 
    189       IF( ln_c14         )   CALL trc_ini_c14        !  C14 model 
    190       IF( ln_age         )   CALL trc_ini_age        !  AGE 
     187      IF( ln_pisces      )   CALL trc_ini_pisces( Kmm )     !  PISCES model 
     188      IF( ln_my_trc      )   CALL trc_ini_my_trc( Kmm )     !  MY_TRC model 
     189      IF( ll_cfc         )   CALL trc_ini_cfc   ( Kmm )     !  CFC's 
     190      IF( ln_c14         )   CALL trc_ini_c14   ( Kmm )     !  C14 model 
     191      IF( ln_age         )   CALL trc_ini_age   ( Kmm )     !  AGE 
    191192      IF( .NOT.ln_pisces ) ALLOCATE( profsed(2) ) 
    192193      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcsms.F90

    r10966 r10975  
    5050      IF( ln_timing )   CALL timing_start('trc_sms') 
    5151      ! 
    52       IF( ln_pisces  )   CALL trc_sms_pisces ( kt, Kbb, Kmm )          ! main program of PISCES  
    53       IF( ll_cfc     )   CALL trc_sms_cfc    ( kt,      Kmm )          ! surface fluxes of CFC 
    54       IF( ln_c14     )   CALL trc_sms_c14    ( kt,      Kmm )          ! surface fluxes of C14 
    55       IF( ln_age     )   CALL trc_sms_age    ( kt,      Kmm )          ! Age tracer 
    56       IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt,     Kmm, Krhs )    ! MY_TRC  tracers 
     52      IF( ln_pisces  )   CALL trc_sms_pisces ( kt, Kbb, Kmm, Krhs )    ! main program of PISCES  
     53      IF( ll_cfc     )   CALL trc_sms_cfc    ( kt, Kbb, Kmm, Krhs )    ! surface fluxes of CFC 
     54      IF( ln_c14     )   CALL trc_sms_c14    ( kt, Kbb, Kmm, Krhs )    ! surface fluxes of C14 
     55      IF( ln_age     )   CALL trc_sms_age    ( kt, Kbb, Kmm, Krhs )    ! Age tracer 
     56      IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt, Kbb, Kmm, Krhs )    ! MY_TRC  tracers 
    5757 
    5858      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcstp.F90

    r10966 r10975  
    100100                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
    101101         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    102                                    CALL trc_wri      ( kt )                       ! output of passive tracers with iom I/O manager 
     102                                   CALL trc_wri      ( kt,      Kmm       )       ! output of passive tracers with iom I/O manager 
    103103                                   CALL trc_sms      ( kt, Kbb, Kmm, Krhs )       ! tracers: sinks and sources 
    104104                                   CALL trc_trp      ( kt, Kbb, Kmm, Krhs, Kaa )  ! transport of passive tracers 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcwri.F90

    r10068 r10975  
    3030CONTAINS 
    3131 
    32    SUBROUTINE trc_wri( kt ) 
     32   SUBROUTINE trc_wri( kt, Kmm ) 
    3333      !!--------------------------------------------------------------------- 
    3434      !!                     ***  ROUTINE trc_wri  *** 
    … …  
    3737      !!--------------------------------------------------------------------- 
    3838      INTEGER, INTENT( in )     :: kt 
     39      INTEGER, INTENT( in )     :: Kmm  ! time level indices 
    3940      ! 
    4041      INTEGER                   :: jn 
    … …  
    5455      ! write the tracer concentrations in the file 
    5556      ! --------------------------------------- 
    56       IF( ln_pisces  )   CALL trc_wri_pisces     ! PISCES  
    57       IF( ll_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    58       IF( ln_c14     )   CALL trc_wri_c14        ! surface fluxes of C14 
    59       IF( ln_age     )   CALL trc_wri_age        ! AGE tracer 
    60       IF( ln_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     57      IF( ln_pisces  )   CALL trc_wri_pisces( Kmm )     ! PISCES  
     58      IF( ll_cfc     )   CALL trc_wri_cfc   ( Kmm )     ! surface fluxes of CFC 
     59      IF( ln_c14     )   CALL trc_wri_c14   ( Kmm )     ! surface fluxes of C14 
     60      IF( ln_age     )   CALL trc_wri_age   ( Kmm )     ! AGE tracer 
     61      IF( ln_my_trc  )   CALL trc_wri_my_trc( Kmm )     ! MY_TRC  tracers 
    6162      ! 
    6263      IF( ln_timing )   CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.