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 – NEMO

Changeset 10975


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