Changeset 10975 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP
- Timestamp:
- 2019-05-13T18:34:33+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP
- Files:
-
- 56 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/AGE/trcini_age.F90
r10070 r10975 25 25 CONTAINS 26 26 27 SUBROUTINE trc_ini_age 27 SUBROUTINE trc_ini_age( Kmm ) 28 28 !!---------------------------------------------------------------------- 29 29 !! *** trc_ini_age *** … … 32 32 !! 33 33 !!---------------------------------------------------------------------- 34 INTEGER, INTENT(in) :: Kmm ! time level indices 34 35 INTEGER :: jn 35 36 CHARACTER(len = 20) :: cltra … … 57 58 58 59 59 IF( .NOT. ln_rsttr ) tr n(:,:,:,jp_age) = 0.60 IF( .NOT. ln_rsttr ) tr(:,:,:,jp_age,Kmm) = 0. 60 61 ! 61 62 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 37 37 CONTAINS 38 38 39 SUBROUTINE trc_sms_age( kt, K mm)39 SUBROUTINE trc_sms_age( kt, Kbb, Kmm, Krhs ) 40 40 !!---------------------------------------------------------------------- 41 41 !! *** trc_sms_age *** … … 45 45 !! ** Method : - 46 46 !!---------------------------------------------------------------------- 47 INTEGER, INTENT(in) :: kt ! ocean time-step index48 INTEGER, INTENT(in) :: K mm! ocean time level47 INTEGER, INTENT(in) :: kt ! ocean time-step index 48 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level 49 49 INTEGER :: jn, jk ! dummy loop index 50 50 !!---------------------------------------------------------------------- … … 58 58 59 59 DO jk = 1, nla_age 60 tr a(:,:,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) 61 61 END DO 62 62 ! 63 tr a(:,:,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) & 64 64 & + frac_add_age * rryear * tmask(:,:,nl_age) 65 65 ! 66 66 DO jk = nlb_age, jpk 67 tr a(:,:,jk,jp_age) = tmask(:,:,jk) * rryear67 tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear 68 68 END DO 69 69 ! 70 IF( l_trdtrc ) CALL trd_trc( tr a(:,:,:,jp_age), jn, jptra_sms, kt, Kmm ) ! save trends70 IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 71 71 ! 72 72 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 21 21 CONTAINS 22 22 23 SUBROUTINE trc_wri_age 23 SUBROUTINE trc_wri_age( Kmm ) 24 24 !!--------------------------------------------------------------------- 25 25 !! *** ROUTINE trc_wri_trc *** … … 27 27 !! ** Purpose : output passive tracers fields 28 28 !!--------------------------------------------------------------------- 29 INTEGER, INTENT(in) :: Kmm ! time level indices 29 30 CHARACTER (len=20) :: cltra 30 31 INTEGER :: jn … … 34 35 35 36 cltra = TRIM( ctrcnm(jp_age) ) ! short title for tracer 36 CALL iom_put( cltra, tr n(:,:,:,jp_age) )37 CALL iom_put( cltra, tr(:,:,:,jp_age,Kmm) ) 37 38 38 39 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/C14/trcini_c14.F90
r10069 r10975 31 31 CONTAINS 32 32 33 SUBROUTINE trc_ini_c14 33 SUBROUTINE trc_ini_c14( Kmm ) 34 34 !!---------------------------------------------------------------------- 35 35 !! *** trc_ini_c14 *** … … 40 40 !!---------------------------------------------------------------------- 41 41 ! 42 INTEGER, INTENT(in) :: Kmm ! time level indices 42 43 REAL(wp) :: ztrai 43 44 INTEGER :: jn … … 57 58 IF(lwp) WRITE(numout,*) ' ==> Ocean C14/C :', rc14init 58 59 ! 59 tr n(:,:,:,jp_c14) = rc14init * tmask(:,:,:)60 tr(:,:,:,jp_c14,Kmm) = rc14init * tmask(:,:,:) 60 61 ! 61 62 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 33 33 CONTAINS 34 34 35 SUBROUTINE trc_sms_c14( kt, K mm)35 SUBROUTINE trc_sms_c14( kt, Kbb, Kmm, Krhs ) 36 36 !!---------------------------------------------------------------------- 37 37 !! *** ROUTINE trc_sms_c14 *** … … 46 46 ! freshwater fluxes which should not impact the C14/C ratio 47 47 ! 48 ! => Delta-C14= ( tr n(...jp_c14) -1)*1000.48 ! => Delta-C14= ( tr(...jp_c14,Kmm) -1)*1000. 49 49 !! 50 50 !!---------------------------------------------------------------------- 51 51 ! 52 INTEGER, INTENT(in) :: kt ! ocean time-step index53 INTEGER, INTENT(in) :: K mm! ocean time level52 INTEGER, INTENT(in) :: kt ! ocean time-step index 53 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level 54 54 ! 55 INTEGER :: ji, jj, jk 55 INTEGER :: ji, jj, jk ! dummy loop indices 56 56 REAL(wp) :: zt, ztp, zsk ! dummy variables 57 57 REAL(wp) :: zsol ! solubility … … 82 82 IF( tmask(ji,jj,1) > 0. ) THEN 83 83 ! 84 zt = MIN( 40. , ts n(ji,jj,1,jp_tem) )84 zt = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) 85 85 ! 86 86 ! Computation of solubility zsol in [mol/(L * atm)] … … 88 88 ztp = ( zt + 273.16 ) * 0.01 89 89 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 * ts n(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) ) 91 91 ! convert solubilities [mol/(L * atm)] -> [mol/(m^3 * ppm)] 92 92 zsol = zsol * 1.e-03 … … 121 121 ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s 122 122 ! already masked 123 qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr b(:,:,1,jp_c14) )123 qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) ) 124 124 125 125 ! cumulation of air-to-sea flux at each time step … … 129 129 DO jj = 1, jpj 130 130 DO ji = 1, jpi 131 tr a(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) 132 132 END DO 133 133 END DO … … 138 138 DO ji = 1, jpi 139 139 ! 140 tr a(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) 141 141 ! 142 142 END DO … … 158 158 ENDIF 159 159 160 IF( l_trdtrc ) CALL trd_trc( tr a(:,:,:,jp_c14), 1, jptra_sms, kt, Kmm ) ! save trends160 IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_c14,Krhs), 1, jptra_sms, kt, Kmm ) ! save trends 161 161 ! 162 162 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 27 27 CONTAINS 28 28 29 SUBROUTINE trc_wri_c14 29 SUBROUTINE trc_wri_c14( Kmm ) 30 30 !!--------------------------------------------------------------------- 31 31 !! *** ROUTINE trc_wri_c14 *** … … 33 33 !! ** Purpose : output additional C14 tracers fields 34 34 !!--------------------------------------------------------------------- 35 INTEGER, INTENT(in) :: Kmm ! time level indices 35 36 CHARACTER (len=20) :: cltra ! short title for tracer 36 37 INTEGER :: ji,jj,jk,jn ! dummy loop indexes … … 43 44 ! --------------------------------------- 44 45 cltra = TRIM( ctrcnm(jp_c14) ) ! short title for tracer 45 CALL iom_put( cltra, tr n(:,:,:,jp_c14) )46 CALL iom_put( cltra, tr(:,:,:,jp_c14,Kmm) ) 46 47 47 48 ! compute and write the tracer diagnostic in the file … … 61 62 DO ji = 1, jpi 62 63 IF( tmask(ji,jj,jk) > 0._wp) THEN 63 z3d (ji,jj,jk) = tr n(ji,jj,jk,jp_c14)64 z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) 64 65 zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) ) 65 66 ENDIF … … 113 114 ENDIF 114 115 IF( iom_use("C14Inv") ) THEN 115 ztemp = glob_sum( 'trcwri_c14', tr n(:,:,:,jp_c14) * cvol(:,:,:) )116 ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) ) 116 117 ztemp = atomc14 * xdicsur * ztemp 117 118 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 31 31 CONTAINS 32 32 33 SUBROUTINE trc_ini_cfc 33 SUBROUTINE trc_ini_cfc( Kmm ) 34 34 !!---------------------------------------------------------------------- 35 35 !! *** trc_ini_cfc *** … … 39 39 !! ** Method : - Read the namcfc namelist and check the parameter values 40 40 !!---------------------------------------------------------------------- 41 INTEGER, INTENT(in) :: Kmm ! time level indices 41 42 INTEGER :: ji, jj, jn, jl, jm, js, io, ierr 42 INTEGER :: iskip = 6 ! number of 1st descriptor lines43 INTEGER :: iskip = 6 ! number of 1st descriptor lines 43 44 REAL(wp) :: zyy, zyd 44 45 CHARACTER(len = 20) :: cltra … … 90 91 DO jl = 1, jp_cfc 91 92 jn = jp_cfc0 + jl - 1 92 tr n(:,:,:,jn) = 0._wp93 tr(:,:,:,jn,Kmm) = 0._wp 93 94 END DO 94 95 ENDIF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/CFC/trcsms_cfc.F90
r10966 r10975 54 54 CONTAINS 55 55 56 SUBROUTINE trc_sms_cfc( kt, K mm)56 SUBROUTINE trc_sms_cfc( kt, Kbb, Kmm, Krhs ) 57 57 !!---------------------------------------------------------------------- 58 58 !! *** ROUTINE trc_sms_cfc *** … … 70 70 !! CFC concentration in pico-mol/m3 71 71 !!---------------------------------------------------------------------- 72 INTEGER, INTENT(in) :: kt ! ocean time-step index73 INTEGER, INTENT(in) :: K mm! ocean time level72 INTEGER, INTENT(in) :: kt ! ocean time-step index 73 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level 74 74 ! 75 75 INTEGER :: ji, jj, jn, jl, jm … … 129 129 ! coefficient for solubility for CFC-11/12 in mol/l/atm 130 130 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 131 ztap = ( ts n(ji,jj,1,jp_tem) + 273.16 ) * 0.01131 ztap = ( ts(ji,jj,1,jp_tem,Kmm) + 273.16 ) * 0.01 132 132 zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 133 133 zsol = EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap ) & 134 & + soa(4,jl) * ztap * ztap + ts n(ji,jj,1,jp_sal) * zdtap )134 & + soa(4,jl) * ztap * ztap + ts(ji,jj,1,jp_sal,Kmm) * zdtap ) 135 135 ELSE 136 136 zsol = 0.e0 … … 143 143 ! Computation of speed transfert 144 144 ! Schmidt number revised in Wanninkhof (2014) 145 zt1 = ts n(ji,jj,1,jp_tem)145 zt1 = ts(ji,jj,1,jp_tem,Kmm) 146 146 zt2 = zt1 * zt1 147 147 zt3 = zt1 * zt2 … … 155 155 156 156 ! Input function : speed *( conc. at equil - concen at surface ) 157 ! tr nin pico-mol/l idem qtr; ak in en m/a158 qtr_cfc(ji,jj,jl) = -zak_cfc * ( tr b(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 ) & 159 159 & * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 160 160 ! Add the surface flux to the trend 161 tr a(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) 162 162 163 163 ! cumulation of surface flux at each time step … … 192 192 IF( l_trdtrc ) THEN 193 193 DO jn = jp_cfc0, jp_cfc1 194 CALL trd_trc( tr a(:,:,:,jn), jn, jptra_sms, kt, Kmm ) ! save trends194 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 195 195 END DO 196 196 END IF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/CFC/trcwri_cfc.F90
r10069 r10975 20 20 CONTAINS 21 21 22 SUBROUTINE trc_wri_cfc 22 SUBROUTINE trc_wri_cfc( Kmm ) 23 23 !!--------------------------------------------------------------------- 24 24 !! *** ROUTINE trc_wri_trc *** … … 26 26 !! ** Purpose : output passive tracers fields 27 27 !!--------------------------------------------------------------------- 28 INTEGER, INTENT(in) :: Kmm ! time level indices 28 29 CHARACTER (len=20) :: cltra 29 30 INTEGER :: jn … … 34 35 DO jn = jp_cfc0, jp_cfc1 35 36 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 36 CALL iom_put( cltra, tr n(:,:,:,jn) )37 CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 37 38 END DO 38 39 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC/trcini_my_trc.F90
r10068 r10975 28 28 CONTAINS 29 29 30 SUBROUTINE trc_ini_my_trc 30 SUBROUTINE trc_ini_my_trc( Kmm ) 31 31 !!---------------------------------------------------------------------- 32 32 !! *** trc_ini_my_trc *** … … 36 36 !! ** Method : - Read the namcfc namelist and check the parameter values 37 37 !!---------------------------------------------------------------------- 38 INTEGER, INTENT(in) :: Kmm ! time level indices 38 39 ! 39 40 CALL trc_nam_my_trc … … 50 51 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 51 52 52 IF( .NOT. ln_rsttr ) tr n(:,:,:,jp_myt0:jp_myt1) = 1.53 IF( .NOT. ln_rsttr ) tr(:,:,:,jp_myt0:jp_myt1,Kmm) = 1. 53 54 ! 54 55 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 32 32 CONTAINS 33 33 34 SUBROUTINE trc_sms_my_trc( kt, K mm, Krhs )34 SUBROUTINE trc_sms_my_trc( kt, Kbb, Kmm, Krhs ) 35 35 !!---------------------------------------------------------------------- 36 36 !! *** trc_sms_my_trc *** … … 42 42 ! 43 43 INTEGER, INTENT(in) :: kt ! ocean time-step index 44 INTEGER, INTENT(in) :: K mm, Krhs ! time level indices44 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 45 45 INTEGER :: jn ! dummy loop index 46 46 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt … … 62 62 IF( l_trdtrc ) THEN 63 63 DO jn = jp_myt0, jp_myt1 64 ztrmyt(:,:,:) = tr a(:,:,:,jn)64 ztrmyt(:,:,:) = tr(:,:,:,jn,Krhs) 65 65 CALL trd_trc( ztrmyt, jn, jptra_sms, kt, Kmm ) ! save trends 66 66 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC/trcwri_my_trc.F90
r10069 r10975 25 25 CONTAINS 26 26 27 SUBROUTINE trc_wri_my_trc 27 SUBROUTINE trc_wri_my_trc( Kmm ) 28 28 !!--------------------------------------------------------------------- 29 29 !! *** ROUTINE trc_wri_trc *** … … 31 31 !! ** Purpose : output passive tracers fields 32 32 !!--------------------------------------------------------------------- 33 INTEGER, INTENT(in) :: Kmm ! time level indices 33 34 CHARACTER (len=20) :: cltra 34 35 INTEGER :: jn … … 39 40 DO jn = jp_myt0, jp_myt1 40 41 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 41 CALL iom_put( cltra, tr n(:,:,:,jn) )42 CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 42 43 END DO 43 44 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zbio.F90
r10425 r10975 65 65 CONTAINS 66 66 67 SUBROUTINE p2z_bio( kt )67 SUBROUTINE p2z_bio( kt, Kmm, Krhs ) 68 68 !!--------------------------------------------------------------------- 69 69 !! *** ROUTINE p2z_bio *** … … 78 78 !! is added to the general trend. 79 79 !! 80 !! tr a = tra + zf...tra- zftra...80 !! tr(Krhs) = tr(Krhs) + zf...tr(Krhs) - zftra... 81 81 !! | | 82 82 !! | | … … 84 84 !! 85 85 !!--------------------------------------------------------------------- 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 87 88 ! 88 89 INTEGER :: ji, jj, jk, jl … … 126 127 127 128 ! negative trophic variables DO not contribute to the fluxes 128 zdet = MAX( 0.e0, tr n(ji,jj,jk,jpdet) )129 zzoo = MAX( 0.e0, tr n(ji,jj,jk,jpzoo) )130 zphy = MAX( 0.e0, tr n(ji,jj,jk,jpphy) )131 zno3 = MAX( 0.e0, tr n(ji,jj,jk,jpno3) )132 znh4 = MAX( 0.e0, tr n(ji,jj,jk,jpnh4) )133 zdom = MAX( 0.e0, tr n(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) ) 134 135 135 136 ! Limitations … … 176 177 ! closure : flux grazing is redistributed below level jpkbio 177 178 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) 179 180 zboddet = fdbod * zzoobod 180 181 … … 202 203 203 204 ! tracer flux at totox-point added to the general trend 204 tr a(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta205 tr a(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa206 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya207 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a208 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a209 tr a(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma205 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 210 211 211 212 IF( lk_iomput ) THEN 212 213 ! convert fluxes in per day 213 ze3t = e3t _n(ji,jj,jk) * 86400._wp214 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 214 215 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 215 216 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 248 249 ! trophic variables( det, zoo, phy, no3, nh4, dom) 249 250 ! negative trophic variables DO not contribute to the fluxes 250 zdet = MAX( 0.e0, tr n(ji,jj,jk,jpdet) )251 zzoo = MAX( 0.e0, tr n(ji,jj,jk,jpzoo) )252 zphy = MAX( 0.e0, tr n(ji,jj,jk,jpphy) )253 zno3 = MAX( 0.e0, tr n(ji,jj,jk,jpno3) )254 znh4 = MAX( 0.e0, tr n(ji,jj,jk,jpnh4) )255 zdom = MAX( 0.e0, tr n(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) ) 256 257 257 258 ! Limitations … … 304 305 305 306 ! tracer flux at totox-point added to the general trend 306 tr a(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta307 tr a(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa308 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya309 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a310 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a311 tr a(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma307 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 312 313 ! 313 314 IF( lk_iomput ) THEN ! convert fluxes in per day 314 ze3t = e3t _n(ji,jj,jk) * 86400._wp315 ze3t = e3t(ji,jj,jk,Kmm) * 86400._wp 315 316 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 316 317 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 370 371 WRITE(charout, FMT="('bio')") 371 372 CALL prt_ctl_trc_info(charout) 372 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)373 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 373 374 ENDIF 374 375 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zexp.F90
r10425 r10975 46 46 CONTAINS 47 47 48 SUBROUTINE p2z_exp( kt )48 SUBROUTINE p2z_exp( kt, Kmm, Krhs ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** ROUTINE p2z_exp *** … … 60 60 !!--------------------------------------------------------------------- 61 61 !! 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 63 64 !! 64 65 INTEGER :: ji, jj, jk, jl, ikt … … 70 71 IF( ln_timing ) CALL timing_start('p2z_exp') 71 72 ! 72 IF( kt == nittrc000 ) CALL p2z_exp_init 73 IF( kt == nittrc000 ) CALL p2z_exp_init( Kmm ) 73 74 74 75 zsedpoca(:,:) = 0. … … 83 84 DO jj = 2, jpjm1 84 85 DO ji = fs_2, fs_jpim1 85 ze3t = 1. / e3t _n(ji,jj,jk)86 tr a(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) 87 88 END DO 88 89 END DO … … 98 99 DO ji = fs_2, fs_jpim1 99 100 ikt = mbkt(ji,jj) 100 tr a(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) 101 102 ! Deposition of organic matter in the sediment 102 zwork = vsed * tr n(ji,jj,ikt,jpdet)103 zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 103 104 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 104 105 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt … … 109 110 DO jj = 2, jpjm1 110 111 DO ji = fs_2, fs_jpim1 111 tr a(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) 112 113 END DO 113 114 END DO … … 149 150 WRITE(charout, FMT="('exp')") 150 151 CALL prt_ctl_trc_info(charout) 151 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)152 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 152 153 ENDIF 153 154 ! … … 157 158 158 159 159 SUBROUTINE p2z_exp_init 160 SUBROUTINE p2z_exp_init( Kmm ) 160 161 !!---------------------------------------------------------------------- 161 162 !! *** ROUTINE p4z_exp_init *** 162 163 !! ** purpose : specific initialisation for export 163 164 !!---------------------------------------------------------------------- 165 INTEGER, INTENT(in) :: Kmm ! time level index 164 166 INTEGER :: ji, jj, jk 165 167 REAL(wp) :: zmaskt, zfluo, zfluu … … 184 186 DO jj = 1, jpj 185 187 DO ji = 1, jpi 186 zfluo = ( gdepw _n(ji,jj,jk ) / gdepw_n(ji,jj,jpkb) )**xhr187 zfluu = ( gdepw _n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr188 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 188 190 IF( zfluo.GT.1. ) zfluo = 1._wp 189 191 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 45 45 CONTAINS 46 46 47 SUBROUTINE p2z_opt( kt )47 SUBROUTINE p2z_opt( kt, Kmm ) 48 48 !!--------------------------------------------------------------------- 49 49 !! *** ROUTINE p2z_opt *** … … 61 61 !! 62 62 INTEGER, INTENT( in ) :: kt ! index of the time stepping 63 INTEGER, INTENT( in ) :: Kmm ! time level index 63 64 !! 64 65 INTEGER :: ji, jj, jk ! dummy loop indices … … 94 95 DO jj = 1, jpj 95 96 DO ji = 1, jpi 96 zpig = LOG( MAX( TINY(0.), tr n(ji,jj,jk-1,jpphy) ) * zcoef )97 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef ) 97 98 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 98 99 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) ) 101 102 END DO 102 103 END DO … … 105 106 DO jj = 1, jpj 106 107 DO ji = 1, jpi 107 zpig = LOG( MAX( TINY(0.), tr n(ji,jj,jk,jpphy) ) * zcoef )108 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef ) 108 109 zkr = xkr0 + xkrp * EXP( xlr * zpig ) 109 110 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) ) ) 112 113 etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 113 114 END DO … … 128 129 DO jj = 1, jpj 129 130 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) 131 132 END DO 132 133 END DO … … 136 137 WRITE(charout, FMT="('opt')") 137 138 CALL prt_ctl_trc_info( charout ) 138 CALL prt_ctl_trc( tab4d=tr n, mask=tmask, clinfo=ctrcnm )139 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 139 140 ENDIF 140 141 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zsed.F90
r10068 r10975 38 38 CONTAINS 39 39 40 SUBROUTINE p2z_sed( kt )40 SUBROUTINE p2z_sed( kt, Kmm, Krhs ) 41 41 !!--------------------------------------------------------------------- 42 42 !! *** ROUTINE p2z_sed *** … … 49 49 !! using an upstream scheme 50 50 !! the now vertical advection of tracers is given by: 51 !! dz(tr n wn) = 1/bt dk+1( e1t e2t vsed (trn) )52 !! add this trend now to the general trend of tracer (ta,sa,tr a):53 !! tr a = 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) 54 54 !! 55 55 !! IF 'key_diabio' is defined, the now vertical advection 56 56 !! trend of passive tracers is saved for futher diagnostics. 57 57 !!--------------------------------------------------------------------- 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 59 60 ! 60 61 INTEGER :: ji, jj, jk, jl, ierr … … 81 82 ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2 82 83 DO jk = 2, jpkm1 83 zwork(:,:,jk) = -vsed * tr n(:,:,jk-1,jpdet)84 zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm) 84 85 END DO 85 86 … … 88 89 DO jj = 1, jpj 89 90 DO ji = 1, jpi 90 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t _n(ji,jj,jk)91 tr a(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) 92 93 END DO 93 94 END DO … … 97 98 IF( iom_use( "TDETSED" ) ) THEN 98 99 ALLOCATE( zw2d(jpi,jpj) ) 99 zw2d(:,:) = ztra(:,:,1) * e3t _n(:,:,1) * 86400._wp100 zw2d(:,:) = ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp 100 101 DO jk = 2, jpkm1 101 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t _n(:,:,jk) * 86400._wp102 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp 102 103 END DO 103 104 CALL iom_put( "TDETSED", zw2d ) … … 110 111 WRITE(charout, FMT="('sed')") 111 112 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)113 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 113 114 ENDIF 114 115 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zsms.F90
r10966 r10975 35 35 CONTAINS 36 36 37 SUBROUTINE p2z_sms( kt, Kmm )37 SUBROUTINE p2z_sms( kt, Kmm, Krhs ) 38 38 !!--------------------------------------------------------------------- 39 39 !! *** ROUTINE p2z_sms *** … … 44 44 !! ** Method : - ??? 45 45 !! -------------------------------------------------------------------- 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index47 INTEGER, INTENT( in ) :: Kmm ! ocean time level index46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 47 INTEGER, INTENT( in ) :: Kmm, Krhs ! ocean time level index 48 48 ! 49 49 INTEGER :: jn ! dummy loop index … … 52 52 IF( ln_timing ) CALL timing_start('p2z_sms') 53 53 ! 54 CALL p2z_opt( kt ) ! optical model55 CALL p2z_bio( kt ) ! biological model56 CALL p2z_sed( kt ) ! sedimentation model57 CALL p2z_exp( kt ) ! export54 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 58 58 ! 59 59 IF( l_trdtrc ) THEN 60 60 DO jn = jp_pcs0, jp_pcs1 61 CALL trd_trc( tr a(:,:,:,jn), jn, jptra_sms, kt, Kmm ) ! save trends61 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 62 62 END DO 63 63 END IF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zagg.F90
r10069 r10975 31 31 CONTAINS 32 32 33 SUBROUTINE p4z_agg ( kt, knt )33 SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs ) 34 34 !!--------------------------------------------------------------------- 35 35 !! *** ROUTINE p4z_agg *** … … 40 40 !!--------------------------------------------------------------------- 41 41 INTEGER, INTENT(in) :: kt, knt ! 42 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 42 43 ! 43 44 INTEGER :: ji, jj, jk … … 63 64 zfact = xstep * xdiss(ji,jj,jk) 64 65 ! Part I : Coagulation dependent on turbulence 65 zagg1 = 25.9 * zfact * tr b(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)66 zagg2 = 4452. * zfact * tr b(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) 67 68 68 69 ! Part II : Differential settling 69 70 70 71 ! Aggregation of small into large particles 71 zagg3 = 47.1 * xstep * tr b(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)72 zagg4 = 3.3 * xstep * tr b(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) 73 74 74 75 zagg = zagg1 + zagg2 + zagg3 + zagg4 75 zaggfe = zagg * tr b(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 ) 76 77 77 78 ! Aggregation of DOC to POC : … … 79 80 ! 2nd term is shear aggregation of DOC-POC 80 81 ! 3rd term is differential settling of DOC-POC 81 zaggdoc = ( ( 0.369 * 0.3 * tr b(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact &82 & + 2.4 * xstep * tr b(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) 83 84 ! transfer of DOC to GOC : 84 85 ! 1st term is shear aggregation 85 86 ! 2nd term is differential settling 86 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr b(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) 87 88 ! tranfer of DOC to POC due to brownian motion 88 zaggdoc3 = 114. * 0.3 * tr b(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) 89 90 90 91 ! Update the trends 91 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc392 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc293 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe94 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe95 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc392 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 96 97 ! 97 98 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3 … … 109 110 zfact = xstep * xdiss(ji,jj,jk) 110 111 ! Part I : Coagulation dependent on turbulence 111 zaggtmp = 25.9 * zfact * tr b(ji,jj,jk,jppoc)112 zaggpoc1 = zaggtmp * tr b(ji,jj,jk,jppoc)113 zaggtmp = 4452. * zfact * tr b(ji,jj,jk,jpgoc)114 zaggpoc2 = zaggtmp * tr b(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) 115 116 116 117 ! Part II : Differential settling 117 118 118 119 ! Aggregation of small into large particles 119 zaggtmp = 47.1 * xstep * tr b(ji,jj,jk,jpgoc)120 zaggpoc3 = zaggtmp * tr b(ji,jj,jk,jppoc)121 zaggtmp = 3.3 * xstep * tr b(ji,jj,jk,jppoc)122 zaggpoc4 = zaggtmp * tr b(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) 123 124 124 125 zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 125 zaggpon = zaggpoc * tr b(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)126 zaggpop = zaggpoc * tr b(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)127 zaggfe = zaggpoc * tr b(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 ) 128 129 129 130 ! Aggregation of DOC to POC : … … 131 132 ! 2nd term is shear aggregation of DOC-POC 132 133 ! 3rd term is differential settling of DOC-POC 133 zaggtmp = ( ( 0.369 * 0.3 * tr b(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact &134 & + 2.4 * xstep * tr b(ji,jj,jk,jppoc) )135 zaggdoc = zaggtmp * 0.3 * tr b(ji,jj,jk,jpdoc)136 zaggdon = zaggtmp * 0.3 * tr b(ji,jj,jk,jpdon)137 zaggdop = zaggtmp * 0.3 * tr b(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) 138 139 139 140 ! transfer of DOC to GOC : 140 141 ! 1st term is shear aggregation 141 142 ! 2nd term is differential settling 142 zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr b(ji,jj,jk,jpgoc)143 zaggdoc2 = zaggtmp * 0.3 * tr b(ji,jj,jk,jpdoc)144 zaggdon2 = zaggtmp * 0.3 * tr b(ji,jj,jk,jpdon)145 zaggdop2 = zaggtmp * 0.3 * tr b(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) 146 147 147 148 ! tranfer of DOC to POC due to brownian motion 148 zaggtmp = ( 114. * 0.3 * tr b(ji,jj,jk,jpdoc) ) * xstep149 zaggdoc3 = zaggtmp * 0.3 * tr b(ji,jj,jk,jpdoc)150 zaggdon3 = zaggtmp * 0.3 * tr b(ji,jj,jk,jpdon)151 zaggdop3 = zaggtmp * 0.3 * tr b(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) 152 153 153 154 ! Update the trends 154 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3155 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3156 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3157 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2158 tr a(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2159 tr a(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2160 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe161 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe162 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3163 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3164 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3155 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 165 166 ! 166 167 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 … … 176 177 WRITE(charout, FMT="('agg')") 177 178 CALL prt_ctl_trc_info(charout) 178 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)179 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 179 180 ENDIF 180 181 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zbio.F90
r10966 r10975 45 45 CONTAINS 46 46 47 SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm )47 SUBROUTINE p4z_bio ( kt, knt, Kbb, Kmm, Krhs ) 48 48 !!--------------------------------------------------------------------- 49 49 !! *** ROUTINE p4z_bio *** … … 56 56 !!--------------------------------------------------------------------- 57 57 INTEGER, INTENT(in) :: kt, knt 58 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices58 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 59 59 ! 60 60 INTEGER :: ji, jj, jk, jn … … 73 73 DO ji = 1, jpi 74 74 !!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.0175 IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 76 76 END DO 77 77 END DO 78 78 END DO 79 79 80 CALL p4z_opt ( kt, knt ) ! Optic: PAR in the water column81 CALL p4z_sink ( kt, knt, Kbb, Kmm ) ! vertical flux of particulate organic matter82 CALL p4z_fechem ( kt, knt ) ! Iron chemistry/scavenging80 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 83 83 ! 84 84 IF( ln_p4z ) THEN 85 CALL p4z_lim ( kt, knt ) ! co-limitations by the various nutrients86 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 89 ! ! zooplankton sources/sinks routines90 CALL p4z_micro( kt, knt )! microzooplankton91 CALL p4z_meso ( kt, knt )! mesozooplankton85 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 92 92 ELSE 93 CALL p5z_lim ( kt, knt ) ! co-limitations by the various nutrients94 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 mortality97 ! ! zooplankton sources/sinks routines98 CALL p5z_micro( kt, knt ) ! microzooplankton99 CALL p5z_meso ( kt, knt ) ! mesozooplankton93 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 100 100 ENDIF 101 101 ! 102 CALL p4z_agg ( kt, knt ) ! Aggregation of particles103 CALL p4z_rem ( kt, knt ) ! remineralization terms of organic matter+scavenging of Fe104 CALL p4z_poc ( kt, knt ) ! Remineralization of organic particles102 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 105 105 ! 106 106 IF( ln_ligand ) & 107 & CALL p4z_ligand( kt, knt )107 & CALL p4z_ligand( kt, knt, Kbb, Krhs ) 108 108 ! ! 109 109 IF(ln_ctl) THEN ! print mean trends (used for debugging) 110 110 WRITE(charout, FMT="('bio ')") 111 111 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)112 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 113 113 ENDIF 114 114 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zche.F90
r10425 r10975 137 137 CONTAINS 138 138 139 SUBROUTINE p4z_che 139 SUBROUTINE p4z_che( Kbb, Kmm ) 140 140 !!--------------------------------------------------------------------- 141 141 !! *** ROUTINE p4z_che *** … … 145 145 !! ** Method : - ... 146 146 !!--------------------------------------------------------------------- 147 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 147 148 INTEGER :: ji, jj, jk 148 149 REAL(wp) :: ztkel, ztkel1, zt , zsal , zsal2 , zbuf1 , zbuf2 … … 164 165 ! ------------------------------------------------------------- 165 166 IF (neos == -1) THEN 166 salinprac(:,:,:) = ts n(:,:,:,jp_sal) * 35.0 / 35.16504167 salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 167 168 ELSE 168 salinprac(:,:,:) = ts n(:,:,:,jp_sal)169 salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 169 170 ENDIF 170 171 … … 178 179 DO jj = 1, jpj 179 180 DO ji = 1, jpi 180 zpres = gdept _n(ji,jj,jk) / 1000.181 za1 = 0.04 * ( 1.0 + 0.185 * ts n(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )182 za2 = 0.0075 * ( 1.0 - ts n(ji,jj,jk,jp_tem) / 30.0 )183 tempis(ji,jj,jk) = ts n(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2181 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 184 185 END DO 185 186 END DO … … 245 246 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 246 247 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-6248 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 248 249 zpres = zpres / 10.0 249 250 … … 448 449 END SUBROUTINE p4z_che 449 450 450 SUBROUTINE ahini_for_at(p_hini )451 SUBROUTINE ahini_for_at(p_hini, Kbb ) 451 452 !!--------------------------------------------------------------------- 452 453 !! *** ROUTINE ahini_for_at *** … … 462 463 !!--------------------------------------------------------------------- 463 464 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini 465 INTEGER, INTENT(in) :: Kbb ! time level indices 464 466 INTEGER :: ji, jj, jk 465 467 REAL(wp) :: zca1, zba1 … … 474 476 DO jj = 1, jpj 475 477 DO ji = 1, jpi 476 p_alkcb = tr b(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)477 p_dictot = tr b(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) 478 480 p_bortot = borat(ji,jj,jk) 479 481 IF (p_alkcb <= 0.) THEN … … 516 518 !=============================================================================== 517 519 518 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup )520 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 519 521 520 522 ! Subroutine returns the lower and upper bounds of "non-water-selfionization" … … 525 527 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 526 528 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(:,:,:) & 529 532 & - fluorid(:,:,:) 530 p_alknw_sup(:,:,:) = (2. * tr b(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) &533 p_alknw_sup(:,:,:) = (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) ) & 531 534 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 532 535 … … 534 537 535 538 536 SUBROUTINE solve_at_general( p_hini, zhi )539 SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 537 540 538 541 ! Universal pH solver that converges from any given initial value, … … 543 546 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini 544 547 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi 548 INTEGER, INTENT(in) :: Kbb ! time level indices 545 549 546 550 ! Local variables … … 565 569 IF( ln_timing ) CALL timing_start('solve_at_general') 566 570 567 CALL anw_infsup( zalknw_inf, zalknw_sup )571 CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 568 572 569 573 rmask(:,:,:) = tmask(:,:,:) … … 575 579 DO ji = 1, jpi 576 580 IF (rmask(ji,jj,jk) == 1.) THEN 577 p_alktot = tr b(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) 578 582 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 579 583 zh_ini = p_hini(ji,jj,jk) … … 609 613 IF (rmask(ji,jj,jk) == 1.) THEN 610 614 zfact = rhop(ji,jj,jk) / 1000. + rtrn 611 p_alktot = tr b(ji,jj,jk,jptal) / zfact612 zdic = tr b(ji,jj,jk,jpdic) / zfact615 p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 616 zdic = tr(ji,jj,jk,jpdic,Kbb) / zfact 613 617 zbot = borat(ji,jj,jk) 614 zpt = tr b(ji,jj,jk,jppo4) / zfact * po4r615 zsit = tr b(ji,jj,jk,jpsil) / zfact618 zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 619 zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 616 620 zst = sulfat (ji,jj,jk) 617 621 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 38 38 CONTAINS 39 39 40 SUBROUTINE p4z_fechem( kt, knt )40 SUBROUTINE p4z_fechem( kt, knt, Kbb, Kmm, Krhs ) 41 41 !!--------------------------------------------------------------------- 42 42 !! *** ROUTINE p4z_fechem *** … … 48 48 !!--------------------------------------------------------------------- 49 49 INTEGER, INTENT(in) :: kt, knt ! ocean time step 50 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 50 51 ! 51 52 INTEGER :: ji, jj, jk, jic, jn … … 79 80 ! ------------------------------------------------- 80 81 IF( ln_ligvar ) THEN 81 ztotlig(:,:,:) = 0.09 * tr b(:,:,:,jpdoc) * 1E6 + ligand * 1E982 ztotlig(:,:,:) = 0.09 * tr(:,:,:,jpdoc,Kbb) * 1E6 + ligand * 1E9 82 83 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 83 84 ELSE 84 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = tr b(:,:,:,jplgw) * 1E985 IF( ln_ligand ) THEN ; ztotlig(:,:,:) = tr(:,:,:,jplgw,Kbb) * 1E9 85 86 ELSE ; ztotlig(:,:,:) = ligand * 1E9 86 87 ENDIF … … 98 99 zkeq = fekeq(ji,jj,jk) 99 100 zfesatur = zTL1(ji,jj,jk) * 1E-9 100 ztfe = tr b(ji,jj,jk,jpfer)101 ztfe = tr(ji,jj,jk,jpfer,Kbb) 101 102 ! Fe' is the root of a 2nd order polynom 102 103 zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe ) & … … 104 105 & + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 105 106 zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 106 zFeL1(ji,jj,jk) = MAX( 0., tr b(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) ) 107 108 END DO 108 109 END DO … … 132 133 precip(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * 1E-9 - fe3sol ) ) * kfep * xstep 133 134 ! 134 ztrc = ( tr b(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6135 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 135 136 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. ) 137 138 IF (ln_ligand) THEN 138 zxlam = xlam1 * MAX( 1.E-3, EXP(-2 * etot(ji,jj,jk) / 10. ) * (1. - EXP(-2 * tr b(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 ) )) 139 140 ELSE 140 141 zxlam = xlam1 * 1.0 … … 146 147 ! to later allocate scavenged iron to the different organic pools 147 148 ! --------------------------------------------------------- 148 zdenom1 = zxlam * tr b(ji,jj,jk,jppoc) / zlam1b149 zdenom2 = zxlam * tr b(ji,jj,jk,jpgoc) / zlam1b149 zdenom1 = zxlam * tr(ji,jj,jk,jppoc,Kbb) / zlam1b 150 zdenom2 = zxlam * tr(ji,jj,jk,jpgoc,Kbb) / zlam1b 150 151 151 152 ! Increased scavenging for very high iron concentrations found near the coasts … … 154 155 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 155 156 zlamfac = MIN( 1. , zlamfac ) 156 zdep = MIN( 1., 1000. / gdept _n(ji,jj,jk) )157 zcoag = 1E-4 * ( 1. - zlamfac ) * zdep * xstep * tr b(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) 158 159 159 160 ! Compute the coagulation of colloidal iron. This parameterization … … 161 162 ! It requires certainly some more work as it is very poorly constrained. 162 163 ! ---------------------------------------------------------------- 163 zlam1a = ( 0.369 * 0.3 * tr b(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) &164 & + ( 114. * 0.3 * tr b(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) ) 165 166 zaggdfea = zlam1a * xstep * zfecoll 166 167 ! 167 zlam1b = 3.53E3 * tr b(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)168 zlam1b = 3.53E3 * tr(ji,jj,jk,jpgoc,Kbb) * xdiss(ji,jj,jk) 168 169 zaggdfeb = zlam1b * xstep * zfecoll 169 170 ! 170 tr a(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 & 171 172 & - zcoag - precip(ji,jj,jk) 172 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea173 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb173 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 174 175 zscav3d(ji,jj,jk) = zscave 175 176 zcoll3d(ji,jj,jk) = zaggdfea + zaggdfeb … … 181 182 ! Define the bioavailable fraction of iron 182 183 ! ---------------------------------------- 183 biron(:,:,:) = tr b(:,:,:,jpfer)184 biron(:,:,:) = tr(:,:,:,jpfer,Kbb) 184 185 ! 185 186 IF( ln_ligand ) THEN … … 188 189 DO jj = 1, jpj 189 190 DO ji = 1, jpi 190 zlam1a = ( 0.369 * 0.3 * tr b(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) &191 & + ( 114. * 0.3 * tr b(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) ) 192 193 ! 193 zlam1b = 3.53E3 * tr b(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)194 zligco = 0.5 * tr n(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) 195 196 zaggliga = zlam1a * xstep * zligco 196 197 zaggligb = zlam1b * xstep * zligco 197 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb198 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) - zaggliga - zaggligb 198 199 zlcoll3d(ji,jj,jk) = zaggliga + zaggligb 199 200 END DO … … 201 202 END DO 202 203 ! 203 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr b(:,:,:,jpfer) +rtrn ) ) )204 plig(:,:,:) = MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( tr(:,:,:,jpfer,Kbb) +rtrn ) ) ) 204 205 ! 205 206 ENDIF … … 223 224 WRITE(charout, FMT="('fechem')") 224 225 CALL prt_ctl_trc_info(charout) 225 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)226 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 226 227 ENDIF 227 228 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zflx.F90
r10425 r10975 59 59 CONTAINS 60 60 61 SUBROUTINE p4z_flx ( kt, knt )61 SUBROUTINE p4z_flx ( kt, knt, Kbb, Kmm, Krhs ) 62 62 !!--------------------------------------------------------------------- 63 63 !! *** ROUTINE p4z_flx *** … … 71 71 !!--------------------------------------------------------------------- 72 72 INTEGER, INTENT(in) :: kt, knt ! 73 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 73 74 ! 74 75 INTEGER :: ji, jj, jm, iind, iindm1 … … 111 112 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 112 113 zfact = rhop(ji,jj,1) / 1000. + rtrn 113 zdic = tr b(ji,jj,1,jpdic)114 zdic = tr(ji,jj,1,jpdic,Kbb) 114 115 zph = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 115 116 ! CALCULATE [H2CO3] … … 127 128 DO jj = 1, jpj 128 129 DO ji = 1, jpi 129 ztc = MIN( 35., ts n(ji,jj,1,jp_tem) )130 ztc = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 130 131 ztc2 = ztc * ztc 131 132 ztc3 = ztc * ztc2 … … 162 163 oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 163 164 ! compute the trend 164 tr a(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) 165 166 166 167 ! Compute O2 flux 167 168 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 168 zflu16 = tr b(ji,jj,1,jpoxy) * zkgo2(ji,jj)169 zflu16 = tr(ji,jj,1,jpoxy,Kbb) * zkgo2(ji,jj) 169 170 zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 170 tr a(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) 171 172 END DO 172 173 END DO … … 182 183 WRITE(charout, FMT="('flx ')") 183 184 CALL prt_ctl_trc_info(charout) 184 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)185 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 185 186 ENDIF 186 187 … … 204 205 ENDIF 205 206 IF( iom_use( "Dpo2" ) ) THEN 206 zw2d(:,:) = ( atcox * patm(:,:) - atcox * tr b(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)207 zw2d(:,:) = ( atcox * patm(:,:) - atcox * tr(:,:,1,jpoxy,Kbb) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 207 208 CALL iom_put( "Dpo2" , zw2d ) 208 209 ENDIF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zint.F90
r10068 r10975 26 26 CONTAINS 27 27 28 SUBROUTINE p4z_int( kt )28 SUBROUTINE p4z_int( kt, Kbb, Kmm ) 29 29 !!--------------------------------------------------------------------- 30 30 !! *** ROUTINE p4z_int *** … … 33 33 !! 34 34 !!--------------------------------------------------------------------- 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 36 37 ! 37 38 INTEGER :: ji, jj ! dummy loop indices … … 43 44 ! Computation of phyto and zoo metabolic rate 44 45 ! ------------------------------------------- 45 tgfunc (:,:,:) = EXP( 0.063913 * ts n(:,:,:,jp_tem) )46 tgfunc2(:,:,:) = EXP( 0.07608 * ts n(:,:,:,jp_tem) )46 tgfunc (:,:,:) = EXP( 0.063913 * ts(:,:,:,jp_tem,Kmm) ) 47 tgfunc2(:,:,:) = EXP( 0.07608 * ts(:,:,:,jp_tem,Kmm) ) 47 48 48 49 ! Computation of the silicon dependant half saturation constant for silica uptake … … 50 51 DO ji = 1, jpi 51 52 DO jj = 1, jpj 52 zvar = tr b(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil)53 zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 53 54 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 54 55 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zligand.F90
r10416 r10975 33 33 CONTAINS 34 34 35 SUBROUTINE p4z_ligand( kt, knt )35 SUBROUTINE p4z_ligand( kt, knt, Kbb, Krhs ) 36 36 !!--------------------------------------------------------------------- 37 37 !! *** ROUTINE p4z_ligand *** … … 39 39 !! ** Purpose : Compute remineralization/scavenging of organic ligands 40 40 !!--------------------------------------------------------------------- 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 42 43 ! 43 44 INTEGER :: ji, jj, jk … … 62 63 ! This is based on the idea that as LGW is lower 63 64 ! there is a larger fraction of refractory OM 64 zlgwr = max( rlgs , rlgw * exp( -2 * (tr b(ji,jj,jk,jplgw)*1e9) ) ) ! years65 zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * tr b(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) 66 67 ! photochem loss of weak ligand 67 zlgwpr = prlgw * xstep * etot(ji,jj,jk) * tr b(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj))68 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr68 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 69 70 zligrem(ji,jj,jk) = zlgwr 70 71 zligpr(ji,jj,jk) = zlgwpr … … 97 98 WRITE(charout, FMT="('ligand1')") 98 99 CALL prt_ctl_trc_info(charout) 99 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)100 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 100 101 ENDIF 101 102 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zlim.F90
r10425 r10975 74 74 CONTAINS 75 75 76 SUBROUTINE p4z_lim( kt, knt )76 SUBROUTINE p4z_lim( kt, knt, Kbb, Kmm ) 77 77 !!--------------------------------------------------------------------- 78 78 !! *** ROUTINE p4z_lim *** … … 84 84 !!--------------------------------------------------------------------- 85 85 INTEGER, INTENT(in) :: kt, knt 86 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 86 87 ! 87 88 INTEGER :: ji, jj, jk … … 101 102 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 102 103 !------------------------------------- 103 zno3 = tr b(ji,jj,jk,jpno3) / 40.e-6104 zno3 = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 104 105 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 105 106 zferlim = MIN( zferlim, 7e-11 ) 106 tr b(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 ) 107 108 108 109 ! Computation of a variable Ks for iron on diatoms taking into account 109 110 ! that increasing biomass is made of generally bigger cells 110 111 !------------------------------------------------ 111 zconcd = MAX( 0.e0 , tr b(ji,jj,jk,jpdia) - xsizedia )112 zconcd2 = tr b(ji,jj,jk,jpdia) - zconcd113 zconcn = MAX( 0.e0 , tr b(ji,jj,jk,jpphy) - xsizephy )114 zconcn2 = tr b(ji,jj,jk,jpphy) - zconcn115 z1_trbphy = 1. / ( tr b(ji,jj,jk,jpphy) + rtrn )116 z1_trbdia = 1. / ( tr b(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 ) 117 118 118 119 concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) … … 126 127 ! Michaelis-Menten Limitation term for nutrients Small bacteria 127 128 ! ------------------------------------------------------------- 128 zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * tr b(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) )129 xnanono3(ji,jj,jk) = tr b(ji,jj,jk,jpno3) * concbnh4 * zdenom130 xnanonh4(ji,jj,jk) = tr b(ji,jj,jk,jpnh4) * concbno3 * zdenom129 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 131 132 ! 132 133 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 133 zlim2 = tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 )134 zlim3 = tr b(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )135 zlim4 = tr b(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) ) 136 137 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 137 138 xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 … … 139 140 ! Michaelis-Menten Limitation term for nutrients Small flagellates 140 141 ! ----------------------------------------------- 141 zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * tr b(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) )142 xnanono3(ji,jj,jk) = tr b(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom143 xnanonh4(ji,jj,jk) = tr b(ji,jj,jk,jpnh4) * zconc0n * zdenom142 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 144 145 ! 145 146 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 146 zlim2 = tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 )147 zratio = tr b(ji,jj,jk,jpnfe) * z1_trbphy148 zironmin = xcoef1 * tr b(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) 149 150 zlim3 = MAX( 0.,( zratio - zironmin ) / qnfelim ) 150 151 xnanopo4(ji,jj,jk) = zlim2 … … 154 155 ! Michaelis-Menten Limitation term for nutrients Diatoms 155 156 ! ---------------------------------------------- 156 zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * tr b(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) )157 xdiatno3(ji,jj,jk) = tr b(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom158 xdiatnh4(ji,jj,jk) = tr b(ji,jj,jk,jpnh4) * zconc1d * zdenom157 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 159 160 ! 160 161 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 161 zlim2 = tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4 )162 zlim3 = tr b(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )163 zratio = tr b(ji,jj,jk,jpdfe) * z1_trbdia164 zironmin = xcoef1 * tr b(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) 165 166 zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim ) 166 167 xdiatpo4(ji,jj,jk) = zlim2 … … 177 178 DO jj = 1, jpj 178 179 DO ji = 1, jpi 179 zlim1 = ( tr b(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 ) &180 & / ( concnno3 * concnnh4 + concnnh4 * tr b(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) )181 zlim2 = tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 )182 zlim3 = tr b(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 5.E-11 )183 ztem1 = MAX( 0., ts n(ji,jj,jk,jp_tem) )184 ztem2 = ts n(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. 185 186 zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) ) 186 187 zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) ) … … 188 189 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 189 190 & * ztem1 / ( 0.1 + ztem1 ) & 190 & * MAX( 1., tr b(ji,jj,jk,jpphy) * 1.e6 / 2. ) &191 & * MAX( 1., tr(ji,jj,jk,jpphy,Kbb) * 1.e6 / 2. ) & 191 192 & * zetot1 * zetot2 & 192 193 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & … … 202 203 DO ji = 1, jpi 203 204 ! denitrification factor computed from O2 levels 204 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr b(ji,jj,jk,jpoxy) ) &205 & / ( oxymin + tr b(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) ) ) 206 207 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 207 208 ! 208 209 ! denitrification factor computed from NO3 levels 209 nitrfac2(ji,jj,jk) = MAX( 0.e0, ( 1.E-6 - tr b(ji,jj,jk,jpno3) ) &210 & / ( 1.E-6 + tr b(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) ) ) 211 212 nitrfac2(ji,jj,jk) = MIN( 1., nitrfac2(ji,jj,jk) ) 212 213 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zlys.F90
r10069 r10975 43 43 CONTAINS 44 44 45 SUBROUTINE p4z_lys( kt, knt )45 SUBROUTINE p4z_lys( kt, knt, Kbb, Krhs ) 46 46 !!--------------------------------------------------------------------- 47 47 !! *** ROUTINE p4z_lys *** … … 54 54 !!--------------------------------------------------------------------- 55 55 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 56 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 56 57 ! 57 58 INTEGER :: ji, jj, jk, jn … … 72 73 ! ------------------------------------------- 73 74 74 CALL solve_at_general( zhinit, zhi )75 CALL solve_at_general( zhinit, zhi, Kbb ) 75 76 76 77 DO jk = 1, jpkm1 77 78 DO jj = 1, jpj 78 79 DO ji = 1, jpi 79 zco3(ji,jj,jk) = tr b(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 & 80 81 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 81 82 hi (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. … … 109 110 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 110 111 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 111 zdispot = kdca * zexcess * tr b(ji,jj,jk,jpcal)112 zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb) 112 113 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 113 114 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 114 115 zcaldiss(ji,jj,jk) = zdispot * rfact2 / rmtss ! calcite dissolution 115 116 ! 116 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)117 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zcaldiss(ji,jj,jk)118 tr a(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) 119 120 END DO 120 121 END DO … … 132 133 WRITE(charout, FMT="('lys ')") 133 134 CALL prt_ctl_trc_info(charout) 134 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)135 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 135 136 ENDIF 136 137 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zmeso.F90
r10367 r10975 51 51 CONTAINS 52 52 53 SUBROUTINE p4z_meso( kt, knt )53 SUBROUTINE p4z_meso( kt, knt, Kbb, Krhs ) 54 54 !!--------------------------------------------------------------------- 55 55 !! *** ROUTINE p4z_meso *** … … 60 60 !!--------------------------------------------------------------------- 61 61 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 62 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 62 63 ! 63 64 INTEGER :: ji, jj, jk … … 89 90 DO jj = 1, jpj 90 91 DO ji = 1, jpi 91 zcompam = MAX( ( tr b(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )92 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 92 93 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 93 94 94 95 ! Respiration rates of both zooplankton 95 96 ! ------------------------------------- 96 zrespz = resrat2 * zfact * ( tr b(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) ) & 97 98 & + 3. * nitrfac(ji,jj,jk) ) 98 99 … … 100 101 ! no real reason except that it seems to be more stable and may mimic predation 101 102 ! --------------------------------------------------------------- 102 ztortz = mzrat2 * 1.e6 * zfact * tr b(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk) )103 ! 104 zcompadi = MAX( ( tr b(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )105 zcompaz = MAX( ( tr b(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )106 zcompapoc = MAX( ( tr b(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 ) 107 108 ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 108 109 ! it is to predation by mesozooplankton 109 110 ! ------------------------------------------------------------------------------- 110 zcompaph = MAX( ( tr b(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &111 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) & 111 112 & * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 112 113 … … 117 118 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 118 119 zdenom2 = zdenom / ( zfood + rtrn ) 119 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr b(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)) 120 121 121 122 zgrazd = zgraze2 * xpref2d * zcompadi * zdenom2 … … 124 125 zgrazpoc = zgraze2 * xpref2c * zcompapoc * zdenom2 125 126 126 zgraznf = zgrazn * tr b(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)127 zgrazf = zgrazd * tr b(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)128 zgrazpof = zgrazpoc * tr b(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) 129 130 130 131 ! Mesozooplankton flux feeding on GOC 131 132 ! ---------------------------------- 132 133 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 133 & * tgfunc2(ji,jj,jk) * tr b(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) & 134 135 & * (1. - nitrfac(ji,jj,jk)) 135 zgrazfffg = zgrazffeg * tr b(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) 136 137 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 137 & * tgfunc2(ji,jj,jk) * tr b(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) & 138 139 & * (1. - nitrfac(ji,jj,jk)) 139 zgrazfffp = zgrazffep * tr b(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) 140 141 ! 141 142 zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg … … 145 146 ! diatoms based aggregates are more prone to fractionation 146 147 ! since they are more porous (marine snow instead of fecal pellets) 147 zratio = tr b(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 ) 148 149 zratio2 = zratio * zratio 149 150 zfrac = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 150 & * tr b(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) &151 & * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 151 152 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 152 zfracfe = zfrac * tr b(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) 153 154 154 155 zgrazffep = zproport * zgrazffep … … 181 182 ! Update the arrays TRA which contain the biological sources and sinks 182 183 zgrarsig = zgrarem2 * sigma2 183 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig184 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig185 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig184 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 186 187 ! 187 188 IF( ln_ligand ) THEN 188 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz189 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem2 - zgrarsig) * ldocz 189 190 zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 190 191 ENDIF 191 192 ! 192 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig193 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2193 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 194 195 zfezoo2(ji,jj,jk) = zgrafer2 195 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig196 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig196 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 197 198 198 199 zmortz = ztortz + zrespz 199 200 zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 200 tr a(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc201 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd202 tr a(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz203 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn204 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )205 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )206 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )207 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )208 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf209 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf210 211 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac201 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 212 213 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 213 214 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 214 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac215 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 215 216 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 216 217 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 217 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe218 tr a(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 & 219 220 & + zgraztotf * unass2 - zfracfe 220 zfracal = tr b(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 ) 221 222 zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 222 223 ! calcite production … … 225 226 ! 226 227 zprcaca = part2 * zprcaca 227 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca228 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca )229 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca228 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 230 231 END DO 231 232 END DO … … 258 259 WRITE(charout, FMT="('meso')") 259 260 CALL prt_ctl_trc_info(charout) 260 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)261 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 261 262 ENDIF 262 263 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zmicro.F90
r10374 r10975 49 49 CONTAINS 50 50 51 SUBROUTINE p4z_micro( kt, knt )51 SUBROUTINE p4z_micro( kt, knt, Kbb, Krhs ) 52 52 !!--------------------------------------------------------------------- 53 53 !! *** ROUTINE p4z_micro *** … … 59 59 INTEGER, INTENT(in) :: kt ! ocean time step 60 60 INTEGER, INTENT(in) :: knt ! ??? 61 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 61 62 ! 62 63 INTEGER :: ji, jj, jk … … 84 85 DO jj = 1, jpj 85 86 DO ji = 1, jpi 86 zcompaz = MAX( ( tr b(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )87 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 87 88 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 88 89 89 90 ! Respiration rates of both zooplankton 90 91 ! ------------------------------------- 91 zrespz = resrat * zfact * tr b(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) ) & 92 93 & + resrat * zfact * 3. * nitrfac(ji,jj,jk) 93 94 … … 95 96 ! no real reason except that it seems to be more stable and may mimic predation. 96 97 ! --------------------------------------------------------------- 97 ztortz = mzrat * 1.e6 * zfact * tr b(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))98 99 zcompadi = MIN( MAX( ( tr b(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )100 zcompaph = MAX( ( tr b(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )101 zcompapoc = MAX( ( tr b(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 ) 102 103 103 104 ! Microzooplankton grazing … … 107 108 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 108 109 zdenom2 = zdenom / ( zfood + rtrn ) 109 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr b(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)) 110 111 111 112 zgrazp = zgraze * xprefn * zcompaph * zdenom2 … … 113 114 zgrazsd = zgraze * xprefd * zcompadi * zdenom2 114 115 115 zgrazpf = zgrazp * tr b(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)116 zgrazmf = zgrazm * tr b(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)117 zgrazsf = zgrazsd * tr b(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) 118 119 ! 119 120 zgraztotc = zgrazp + zgrazm + zgrazsd … … 140 141 ! ------------------------ 141 142 zgrarsig = zgrarem * sigma1 142 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig143 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig144 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig143 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 145 146 ! 146 147 IF( ln_ligand ) THEN 147 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz148 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz 148 149 zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz 149 150 ENDIF 150 151 ! 151 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig152 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer152 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 153 154 zfezoo(ji,jj,jk) = zgrafer 154 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc155 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc 155 156 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc 156 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass157 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig158 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig157 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 159 160 ! Update the arrays TRA which contain the biological sources and sinks 160 161 ! -------------------------------------------------------------------- 161 162 zmortz = ztortz + zrespz 162 tr a(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztotc163 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp164 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd165 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)166 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)167 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)168 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)169 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf170 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf171 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm163 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 172 173 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 173 174 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 174 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf175 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf 175 176 ! 176 177 ! calcite production … … 179 180 ! 180 181 zprcaca = part * zprcaca 181 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca182 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca183 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca182 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 184 185 END DO 185 186 END DO … … 210 211 WRITE(charout, FMT="('micro')") 211 212 CALL prt_ctl_trc_info(charout) 212 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)213 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 213 214 ENDIF 214 215 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zmort.F90
r10227 r10975 36 36 CONTAINS 37 37 38 SUBROUTINE p4z_mort( kt )38 SUBROUTINE p4z_mort( kt, Kbb, Krhs ) 39 39 !!--------------------------------------------------------------------- 40 40 !! *** ROUTINE p4z_mort *** … … 46 46 !!--------------------------------------------------------------------- 47 47 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 53 54 ! 54 55 END SUBROUTINE p4z_mort 55 56 56 57 57 SUBROUTINE p4z_nano 58 SUBROUTINE p4z_nano( Kbb, Krhs ) 58 59 !!--------------------------------------------------------------------- 59 60 !! *** ROUTINE p4z_nano *** … … 63 64 !! ** Method : - ??? 64 65 !!--------------------------------------------------------------------- 66 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 65 67 INTEGER :: ji, jj, jk 66 68 REAL(wp) :: zsizerat, zcompaph … … 76 78 DO jj = 1, jpj 77 79 DO ji = 1, jpi 78 zcompaph = MAX( ( tr b(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )80 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 79 81 ! When highly limited by macronutrients, very small cells 80 82 ! dominate the community. As a consequence, aggregation 81 83 ! due to turbulence is negligible. Mortality is also set 82 84 ! to 0 83 zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr b(ji,jj,jk,jpphy)85 zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb) 84 86 ! Squared mortality of Phyto similar to a sedimentation term during 85 87 ! blooms (Doney et al. 1996) … … 89 91 ! increased when nutrients are limiting phytoplankton growth 90 92 ! as observed for instance in case of iron limitation. 91 ztortp = mprat * xstep * zcompaph / ( xkmort + tr b(ji,jj,jk,jpphy) ) * zsizerat93 ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat 92 94 93 95 zmortp = zrespp + ztortp … … 95 97 ! Update the arrays TRA which contains the biological sources and sinks 96 98 97 zfactfe = tr b(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)98 zfactch = tr b(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)99 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp100 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch101 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe99 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 102 104 zprcaca = xfracal(ji,jj,jk) * zmortp 103 105 ! … … 105 107 ! 106 108 zfracal = 0.5 * xfracal(ji,jj,jk) 107 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca108 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca109 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca110 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp111 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp109 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 112 114 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 113 115 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 114 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe115 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe116 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 116 118 END DO 117 119 END DO … … 121 123 WRITE(charout, FMT="('nano')") 122 124 CALL prt_ctl_trc_info(charout) 123 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)125 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 124 126 ENDIF 125 127 ! … … 129 131 130 132 131 SUBROUTINE p4z_diat 133 SUBROUTINE p4z_diat( Kbb, Krhs ) 132 134 !!--------------------------------------------------------------------- 133 135 !! *** ROUTINE p4z_diat *** … … 137 139 !! ** Method : - ??? 138 140 !!--------------------------------------------------------------------- 141 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 139 142 INTEGER :: ji, jj, jk 140 143 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi … … 155 158 DO ji = 1, jpi 156 159 157 zcompadi = MAX( ( tr b(ji,jj,jk,jpdia) - 1e-9), 0. )160 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) 158 161 159 162 ! Aggregation term for diatoms is increased in case of nutrient … … 165 168 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 166 169 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 167 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr b(ji,jj,jk,jpdia)170 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 168 171 169 172 ! Phytoplankton mortality. 170 173 ! ------------------------ 171 ztortp2 = mprat2 * xstep * tr b(ji,jj,jk,jpdia) / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi174 ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb) / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi 172 175 173 176 zmortp2 = zrespp2 + ztortp2 174 177 175 ! Update the arrays tr awhich contains the biological sources and sinks178 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 176 179 ! --------------------------------------------------------------------- 177 zfactch = tr b(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )178 zfactfe = tr b(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )179 zfactsi = tr b(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )180 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2181 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch182 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe183 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi184 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi185 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2186 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2180 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 187 190 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 188 191 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 189 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe190 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe192 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 191 194 END DO 192 195 END DO … … 196 199 WRITE(charout, FMT="('diat')") 197 200 CALL prt_ctl_trc_info(charout) 198 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)201 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 199 202 ENDIF 200 203 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zopt.F90
r10522 r10975 49 49 CONTAINS 50 50 51 SUBROUTINE p4z_opt( kt, knt )51 SUBROUTINE p4z_opt( kt, knt, Kbb, Kmm ) 52 52 !!--------------------------------------------------------------------- 53 53 !! *** ROUTINE p4z_opt *** … … 59 59 !!--------------------------------------------------------------------- 60 60 INTEGER, INTENT(in) :: kt, knt ! ocean time step 61 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 61 62 ! 62 63 INTEGER :: ji, jj, jk … … 83 84 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 84 85 ! ! -------------------------------------------------------- 85 zchl3d(:,:,:) = tr b(:,:,:,jpnch) + trb(:,:,:,jpdch)86 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr b(:,:,:,jppch)86 zchl3d(:,:,:) = tr(:,:,:,jpnch,Kbb) + tr(:,:,:,jpdch,Kbb) 87 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 87 88 ! 88 89 DO jk = 1, jpkm1 … … 93 94 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 94 95 ! 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) 98 99 END DO 99 100 END DO … … 105 106 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 106 107 ! 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 ) 108 109 ! 109 110 DO jk = 1, nksrp … … 120 121 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 121 122 ! 122 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )123 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 ) 123 124 ! 124 125 DO jk = 1, nksrp … … 130 131 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 131 132 ! 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 ) 133 134 ! 134 135 DO jk = 1, nksrp … … 148 149 IF( ln_qsr_bio ) THEN !* heat flux accros w-level (used in the dynamics) 149 150 ! ! ------------------------ 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 ) 151 152 ! 152 153 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) … … 158 159 ! !* Euphotic depth and level 159 160 neln (:,:) = 1 ! ------------------------ 160 heup (:,:) = gdepw _n(:,:,2)161 heup_01(:,:) = gdepw _n(:,:,2)161 heup (:,:) = gdepw(:,:,2,Kmm) 162 heup_01(:,:) = gdepw(:,:,2,Kmm) 162 163 163 164 DO jk = 2, nksrp … … 167 168 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 168 169 ! ! 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 depth170 heup(ji,jj) = gdepw(ji,jj,jk+1,Kmm) ! Euphotic layer depth 170 171 ENDIF 171 172 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) 173 174 ENDIF 174 175 END DO … … 186 187 DO jj = 1, jpj 187 188 DO ji = 1, jpi 188 IF( gdepw _n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN189 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t _n(ji,jj,jk) ! remineralisation190 zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * e3t _n(ji,jj,jk) ! production191 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) 192 193 ENDIF 193 194 END DO … … 201 202 DO jj = 1, jpj 202 203 DO ji = 1, jpi 203 IF( gdepw _n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN204 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 204 205 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 205 206 emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep … … 217 218 DO jj = 1, jpj 218 219 DO ji = 1, jpi 219 IF( gdepw _n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN220 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t _n(ji,jj,jk) ! production221 zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat (ji,jj,jk) * e3t _n(ji,jj,jk) ! production222 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) 223 224 ENDIF 224 225 END DO … … 231 232 DO jj = 1, jpj 232 233 DO ji = 1, jpi 233 IF( gdepw _n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN234 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 234 235 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 235 236 enanom(ji,jj,jk) = zetmp3(ji,jj) * z1_dep … … 245 246 DO jj = 1, jpj 246 247 DO ji = 1, jpi 247 IF( gdepw _n(ji,jj,jk+1) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN248 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t _n(ji,jj,jk) ! production248 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 249 250 ENDIF 250 251 END DO … … 257 258 DO jj = 1, jpj 258 259 DO ji = 1, jpi 259 IF( gdepw _n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN260 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 260 261 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 261 262 epicom(ji,jj,jk) = zetmp5(ji,jj) * z1_dep … … 279 280 280 281 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 ) 282 283 !!---------------------------------------------------------------------- 283 284 !! *** routine p4z_opt_par *** … … 288 289 !!---------------------------------------------------------------------- 289 290 INTEGER , INTENT(in) :: kt ! ocean time-step 291 INTEGER , INTENT(in) :: Kmm ! ocean time-index 290 292 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pqsr ! shortwave 291 293 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) … … 315 317 DO jj = 1, jpj 316 318 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 ) 318 320 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 319 321 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 44 44 CONTAINS 45 45 46 SUBROUTINE p4z_poc( kt, knt )46 SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs ) 47 47 !!--------------------------------------------------------------------- 48 48 !! *** ROUTINE p4z_poc *** … … 52 52 !! ** Method : - ??? 53 53 !!--------------------------------------------------------------------- 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 55 56 ! 56 57 INTEGER :: ji, jj, jk, jn … … 112 113 ! ------------------------------------------------------------ 113 114 ! 114 IF( gdept _n(ji,jj,jk) > zdep ) THEN115 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 115 116 alphat = 0. 116 117 remint = 0. 117 118 ! 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) 120 121 ! 121 IF ( gdept _n(ji,jj,jk-1) <= zdep ) THEN122 IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 122 123 ! 123 124 ! The first level just below the mixed layer needs a … … 130 131 ! POC concentration is computed using the lagrangian 131 132 ! framework. It is only used for the lability param 132 zpoc = tr b(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) 134 135 zpoc = MAX(0., zpoc) 135 136 ! … … 157 158 ! --------------------------------------------------- 158 159 ! 159 zpoc = tr b(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) 162 163 zpoc = max(0., zpoc) 163 164 ! … … 197 198 ! -------------------------------------------------------- 198 199 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 199 zorem2 = zremig * tr b(ji,jj,jk,jpgoc)200 zorem2 = zremig * tr(ji,jj,jk,jpgoc,Kbb) 200 201 orem(ji,jj,jk) = zorem2 201 zorem3(ji,jj,jk) = zremig * solgoc * tr b(ji,jj,jk,jpgoc)202 zofer2 = zremig * tr b(ji,jj,jk,jpbfe)203 zofer3 = zremig * solgoc * tr b(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) 204 205 205 206 ! ------------------------------------- 206 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk)207 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk)208 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3209 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3210 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2211 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2207 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 212 213 zfolimi(ji,jj,jk) = zofer2 213 214 END DO … … 221 222 ! -------------------------------------------------------- 222 223 zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 223 zopoc2 = zremig * tr b(ji,jj,jk,jpgoc)224 zopoc2 = zremig * tr(ji,jj,jk,jpgoc,Kbb) 224 225 orem(ji,jj,jk) = zopoc2 225 zorem3(ji,jj,jk) = zremig * solgoc * tr b(ji,jj,jk,jpgoc)226 zopon2 = xremipn / xremipc * zremig * tr b(ji,jj,jk,jpgon)227 zopop2 = xremipp / xremipc * zremig * tr b(ji,jj,jk,jpgop)228 zofer2 = xremipn / xremipc * zremig * tr b(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) 229 230 230 231 ! ------------------------------------- 231 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk)232 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2233 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2234 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2235 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2236 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2237 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2238 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2239 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk)240 tr a(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc)241 tr a(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc)242 tr a(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) 243 244 zfolimi(ji,jj,jk) = zofer2 244 245 END DO … … 250 251 WRITE(charout, FMT="('poc1')") 251 252 CALL prt_ctl_trc_info(charout) 252 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)253 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 253 254 ENDIF 254 255 … … 271 272 DO ji = 1, jpi 272 273 zdep = hmld(ji,jj) 273 IF (tmask(ji,jj,jk) == 1. .AND. gdept _n(ji,jj,jk) <= zdep ) THEN274 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t _n(ji,jj,jk) * rday/ rfact2274 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 275 276 ! 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 & / ( tr b(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 ) 279 280 ENDIF 280 281 END DO … … 292 293 alphat = 0.0 293 294 remint = 0.0 294 IF( gdept _n(ji,jj,jk) <= zdep ) THEN295 IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 295 296 DO jn = 1, jcpoc 296 297 ! For each lability class, the system is supposed to be … … 329 330 IF (tmask(ji,jj,jk) == 1.) THEN 330 331 zdep = hmld(ji,jj) 331 IF( gdept _n(ji,jj,jk) > zdep ) THEN332 IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 332 333 alphat = 0. 333 334 remint = 0. 334 335 ! 335 336 ! 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) 338 339 ! 339 340 ! Special treatment of the level just below the MXL … … 341 342 ! --------------------------------------------------- 342 343 ! 343 IF ( gdept _n(ji,jj,jk-1) <= zdep ) THEN344 IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 344 345 ! 345 346 ! Computation of the POC concentration using the 346 347 ! lagrangian algorithm 347 zpoc = tr b(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) 349 350 zpoc = max(0., zpoc) 350 351 ! … … 366 367 ! -------------------------------------------------------- 367 368 ! 368 zpoc = tr b(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) 371 372 zpoc = max(0., zpoc) 372 373 ! … … 409 410 ! -------------------------------------------------------- 410 411 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 411 zorem = zremip * tr b(ji,jj,jk,jppoc)412 zofer = zremip * tr b(ji,jj,jk,jpsfe)413 414 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem412 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 415 416 orem(ji,jj,jk) = orem(ji,jj,jk) + zorem 416 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer417 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem418 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer417 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 419 420 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 420 421 ENDIF … … 429 430 ! -------------------------------------------------------- 430 431 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 431 zopoc = zremip * tr b(ji,jj,jk,jppoc)432 zopoc = zremip * tr(ji,jj,jk,jppoc,Kbb) 432 433 orem(ji,jj,jk) = orem(ji,jj,jk) + zopoc 433 zopon = xremipn / xremipc * zremip * tr b(ji,jj,jk,jppon)434 zopop = xremipp / xremipc * zremip * tr b(ji,jj,jk,jppop)435 zofer = xremipn / xremipc * zremip * tr b(ji,jj,jk,jpsfe)436 437 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc438 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon439 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop440 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer441 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc442 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon443 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop444 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer434 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 445 446 zfolimi(ji,jj,jk) = zfolimi(ji,jj,jk) + zofer 446 447 END DO … … 461 462 WRITE(charout, FMT="('poc2')") 462 463 CALL prt_ctl_trc_info(charout) 463 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)464 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 464 465 ENDIF 465 466 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zprod.F90
r10425 r10975 53 53 CONTAINS 54 54 55 SUBROUTINE p4z_prod( kt , knt )55 SUBROUTINE p4z_prod( kt , knt, Kbb, Kmm, Krhs ) 56 56 !!--------------------------------------------------------------------- 57 57 !! *** ROUTINE p4z_prod *** … … 63 63 !!--------------------------------------------------------------------- 64 64 INTEGER, INTENT(in) :: kt, knt ! 65 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 65 66 ! 66 67 INTEGER :: ji, jj, jk … … 119 120 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 120 121 zval = MAX( 1., zstrn(ji,jj) ) 121 IF( gdept _n(ji,jj,jk) <= hmld(ji,jj) ) THEN122 IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN 122 123 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 123 124 ENDIF … … 140 141 DO ji = 1, jpi 141 142 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 142 ztn = MAX( 0., ts n(ji,jj,jk,jp_tem) - 15. )143 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 143 144 zadap = xadap * ztn / ( 2.+ ztn ) 144 zconctemp = MAX( 0.e0 , tr b(ji,jj,jk,jpdia) - xsizedia )145 zconctemp2 = tr b(ji,jj,jk,jpdia) - zconctemp145 zconctemp = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia ) 146 zconctemp2 = tr(ji,jj,jk,jpdia,Kbb) - zconctemp 146 147 ! 147 148 zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap * EXP( -0.25 * enano(ji,jj,jk) ) ) & 148 & * tr b(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) 149 150 ! 150 zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr b(ji,jj,jk,jpdia) + rtrn ) &151 & * tr b(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) 152 153 ENDIF 153 154 END DO … … 204 205 ! Si/C is arbitrariliy increased for very high Si concentrations 205 206 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 206 zlim = tr b(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 ) 207 208 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 208 209 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 209 zsiborn = tr b(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) 210 211 IF (gphit(ji,jj) < -30 ) THEN 211 212 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) … … 239 240 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 240 241 ! production terms for nanophyto. (C) 241 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr b(ji,jj,jk,jpphy) * rfact2242 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 242 243 zpronewn(ji,jj,jk) = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 243 244 ! 244 zratio = tr b(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 ) 245 246 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 246 247 zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 247 248 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 248 249 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 249 & * zmax * tr b(ji,jj,jk,jpphy) * rfact2250 & * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2 250 251 ! production terms for diatoms (C) 251 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr b(ji,jj,jk,jpdia) * rfact2252 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 252 253 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 253 254 ! 254 zratio = tr b(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 ) 255 256 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 256 257 zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 257 258 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 258 259 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 259 & * zmax * tr b(ji,jj,jk,jpdia) * rfact2260 & * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2 260 261 ENDIF 261 262 END DO … … 272 273 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 273 274 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 274 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts n(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.)) 275 276 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 276 277 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) … … 279 280 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 280 281 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 281 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts n(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.)) 282 283 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 283 284 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 284 285 ! Update the arrays TRA which contain the Chla sources and sinks 285 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn286 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd286 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 287 288 ENDIF 288 289 END DO … … 298 299 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 299 300 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 300 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)301 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)302 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2303 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn304 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn305 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd306 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd307 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd308 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod309 tr a(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) & 310 311 & + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 311 312 ! 312 313 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 313 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup314 tr a(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)315 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)316 tr a(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) ) & 317 318 & - rno3 * ( zproreg + zproreg2 ) 318 319 ENDIF … … 328 329 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 329 330 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 330 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet331 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 331 332 zpligprod1(ji,jj,jk) = zdocprod * ldocp 332 333 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet … … 413 414 zw2d(:,:) = 0. 414 415 DO jk = 1, jpkm1 415 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t _n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano416 zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by nano 416 417 ENDDO 417 418 CALL iom_put( "INTPPPHYN" , zw2d ) … … 419 420 zw2d(:,:) = 0. 420 421 DO jk = 1, jpkm1 421 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t _n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom422 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert. integrated primary produc. by diatom 422 423 ENDDO 423 424 CALL iom_put( "INTPPPHYD" , zw2d ) … … 426 427 zw2d(:,:) = 0. 427 428 DO jk = 1, jpkm1 428 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t _n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp429 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert. integrated pp 429 430 ENDDO 430 431 CALL iom_put( "INTPP" , zw2d ) … … 433 434 zw2d(:,:) = 0. 434 435 DO jk = 1, jpkm1 435 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t _n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated new prod436 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert. integrated new prod 436 437 ENDDO 437 438 CALL iom_put( "INTPNEW" , zw2d ) … … 440 441 zw2d(:,:) = 0. 441 442 DO jk = 1, jpkm1 442 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t _n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod443 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 443 444 ENDDO 444 445 CALL iom_put( "INTPBFE" , zw2d ) … … 447 448 zw2d(:,:) = 0. 448 449 DO jk = 1, jpkm1 449 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t _n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bsi prod450 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t(:,:,jk,Kmm) * zfact * tmask(:,:,jk) ! vert integr. bsi prod 450 451 ENDDO 451 452 CALL iom_put( "INTPBSI" , zw2d ) … … 460 461 WRITE(charout, FMT="('prod')") 461 462 CALL prt_ctl_trc_info(charout) 462 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)463 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 463 464 ENDIF 464 465 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zrem.F90
r10425 r10975 49 49 CONTAINS 50 50 51 SUBROUTINE p4z_rem( kt, knt )51 SUBROUTINE p4z_rem( kt, knt, Kbb, Kmm, Krhs ) 52 52 !!--------------------------------------------------------------------- 53 53 !! *** ROUTINE p4z_rem *** … … 57 57 !! ** Method : - ??? 58 58 !!--------------------------------------------------------------------- 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 60 61 ! 61 62 INTEGER :: ji, jj, jk … … 90 91 DO ji = 1, jpi 91 92 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 92 IF( gdept _n(ji,jj,jk) < zdep ) THEN93 zdepbac(ji,jj,jk) = MIN( 0.7 * ( tr b(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 ) 94 95 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 95 96 ELSE 96 zdepmin = MIN( 1., zdep / gdept _n(ji,jj,jk) )97 zdepmin = MIN( 1., zdep / gdept(ji,jj,jk,Kmm) ) 97 98 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 98 99 zdepprod(ji,jj,jk) = zdepmin**0.273 … … 113 114 ! Ammonification in oxic waters with oxygen consumption 114 115 ! ----------------------------------------------------- 115 zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * tr b(ji,jj,jk,jpdoc)116 zolimi(ji,jj,jk) = MIN( ( tr b(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 ) 117 118 ! Ammonification in suboxic waters with denitrification 118 119 ! ------------------------------------------------------- 119 zammonic = zremik * nitrfac(ji,jj,jk) * tr b(ji,jj,jk,jpdoc)120 zammonic = zremik * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 120 121 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 121 denitr(ji,jj,jk) = MIN( ( tr b(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) ) 122 123 zoxyremc = zammonic - denitr(ji,jj,jk) 123 124 ! … … 127 128 128 129 ! 129 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc130 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc131 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit132 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) - zoxyremc133 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut134 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) + zoxyremc135 tr a(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 & 136 137 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 137 138 END DO … … 154 155 ! Ammonification in oxic waters with oxygen consumption 155 156 ! ----------------------------------------------------- 156 zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * tr b(ji,jj,jk,jpdoc)157 zolimic = MAX( 0.e0, MIN( ( tr b(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 ) ) 158 159 zolimi(ji,jj,jk) = zolimic 159 zolimin = zremikn * zolimic * tr b(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )160 zolimip = zremikp * zolimic * tr b(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 ) 161 162 162 163 ! Ammonification in suboxic waters with denitrification 163 164 ! ------------------------------------------------------- 164 zammonic = zremikc * nitrfac(ji,jj,jk) * tr b(ji,jj,jk,jpdoc)165 zammonic = zremikc * nitrfac(ji,jj,jk) * tr(ji,jj,jk,jpdoc,Kbb) 165 166 denitr(ji,jj,jk) = zammonic * ( 1. - nitrfac2(ji,jj,jk) ) 166 denitr(ji,jj,jk) = MAX(0., MIN( ( tr b(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) ) ) 167 168 zoxyremc = MAX(0., zammonic - denitr(ji,jj,jk)) 168 zdenitrn = zremikn * denitr(ji,jj,jk) * tr b(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )169 zdenitrp = zremikp * denitr(ji,jj,jk) * tr b(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )170 zoxyremn = zremikn * zoxyremc * tr b(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )171 zoxyremp = zremikp * zoxyremc * tr b(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )172 173 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp + zoxyremp174 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn + zoxyremn175 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit176 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) - zoxyremc177 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn - zoxyremn178 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp - zoxyremp179 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut180 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) + zoxyremc181 tr a(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 ) 182 183 END DO 183 184 END DO … … 193 194 ! below 2 umol/L. Inhibited at strong light 194 195 ! ---------------------------------------------------------- 195 zonitr = nitrif * xstep * tr b(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) ) &196 zonitr = nitrif * xstep * tr(ji,jj,jk,jpnh4,Kbb) * ( 1.- nitrfac(ji,jj,jk) ) & 196 197 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 197 zdenitnh4 = nitrif * xstep * tr b(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)198 zdenitnh4 = MIN( ( tr b(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 ) 199 200 ! Update of the tracers trends 200 201 ! ---------------------------- 201 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4202 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4203 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr204 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4202 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 205 206 END DO 206 207 END DO … … 210 211 WRITE(charout, FMT="('rem1')") 211 212 CALL prt_ctl_trc_info(charout) 212 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)213 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 213 214 ENDIF 214 215 … … 222 223 ! ---------------------------------------------------------- 223 224 zbactfer = feratb * rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk) & 224 & * tr b(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) ) &225 & * tr(ji,jj,jk,jpfer,Kbb) / ( xkferb + tr(ji,jj,jk,jpfer,Kbb) ) & 225 226 & * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 226 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33227 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25228 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08227 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 229 230 zfebact(ji,jj,jk) = zbactfer * 0.33 230 231 blim(ji,jj,jk) = xlimbacl(ji,jj,jk) * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) … … 236 237 WRITE(charout, FMT="('rem2')") 237 238 CALL prt_ctl_trc_info(charout) 238 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)239 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 239 240 ENDIF 240 241 … … 247 248 DO ji = 1, jpi 248 249 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 249 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr b(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) )250 zsatur2 = ( 1. + ts n(ji,jj,jk,jp_tem) / 400.)**37251 znusil = 0.225 * ( 1. + ts n(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25250 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 252 253 ! Remineralization rate of BSi depedant on T and saturation 253 254 ! --------------------------------------------------------- 254 IF ( gdept _n(ji,jj,jk) > zdep ) THEN255 IF ( gdept(ji,jj,jk,Kmm) > zdep ) THEN 255 256 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) ) 257 258 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 258 259 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) ) 260 261 ENDIF 261 262 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 262 zosil = zsiremin * tr b(ji,jj,jk,jpgsi)263 zosil = zsiremin * tr(ji,jj,jk,jpgsi,Kbb) 263 264 ! 264 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil265 tr a(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil265 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 266 267 END DO 267 268 END DO … … 271 272 WRITE(charout, FMT="('rem3')") 272 273 CALL prt_ctl_trc_info(charout) 273 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)274 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 274 275 ENDIF 275 276 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsbc.F90
r10522 r10975 86 86 CONTAINS 87 87 88 SUBROUTINE p4z_sbc( kt )88 SUBROUTINE p4z_sbc( kt, Kmm ) 89 89 !!---------------------------------------------------------------------- 90 90 !! *** routine p4z_sbc *** … … 98 98 !!---------------------------------------------------------------------- 99 99 INTEGER, INTENT(in) :: kt ! ocean time step 100 INTEGER, INTENT(in) :: Kmm ! time level indices 100 101 ! 101 102 INTEGER :: ji, jj … … 177 178 zcoef = rno3 * 14E6 * ryyss 178 179 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) ) 180 181 ENDIF 181 182 IF( .NOT.ln_linssh ) THEN 182 183 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) ) 184 185 ENDIF 185 186 ENDIF … … 190 191 191 192 192 SUBROUTINE p4z_sbc_init 193 SUBROUTINE p4z_sbc_init( Kmm ) 193 194 !!---------------------------------------------------------------------- 194 195 !! *** routine p4z_sbc_init *** … … 202 203 !! 203 204 !!---------------------------------------------------------------------- 205 INTEGER, INTENT(in) :: Kmm ! time level indices 204 206 INTEGER :: ji, jj, jk, jm, ifpr 205 207 INTEGER :: ii0, ii1, ij0, ij1 … … 286 288 IF( l_offline ) THEN 287 289 nk_rnf(:,:) = 1 288 h_rnf (:,:) = gdept _n(:,:,1)290 h_rnf (:,:) = gdept(:,:,1,Kmm) 289 291 ENDIF 290 292 … … 299 301 ! 300 302 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_s ed_init: unable to allocate sf_dust structure' )302 ! 303 CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_s ed_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' ) 304 306 ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1) ) 305 307 IF( sn_dust%ln_tint ) ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) … … 323 325 ! 324 326 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_s ed_init: unable to allocate sf_solub structure' )326 ! 327 CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_s ed_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' ) 328 330 ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1) ) 329 331 IF( sn_solub%ln_tint ) ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) ) … … 348 350 rivinput(:) = 0._wp 349 351 350 IF( ierr1 > 0 ) CALL ctl_stop( 'STOP', 'p4z_s ed_init: unable to allocate sf_irver structure' )351 ! 352 CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_s ed_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' ) 353 355 DO ifpr = 1, jpriv 354 356 ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1 ) ) … … 397 399 ! 398 400 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_s ed_init: unable to allocate sf_ndepo structure' )400 ! 401 CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_s ed_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' ) 402 404 ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1) ) 403 405 IF( sn_ndepo%ln_tint ) ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) ) … … 453 455 DO jj = 1, jpj 454 456 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) ) 456 458 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 457 459 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) … … 487 489 ENDIF 488 490 ! 489 IF( ll_sbc ) CALL p4z_sbc( nit000 )491 IF( ll_sbc ) CALL p4z_sbc( nit000, Kmm ) 490 492 ! 491 493 IF(lwp) THEN -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsed.F90
r10425 r10975 39 39 CONTAINS 40 40 41 SUBROUTINE p4z_sed( kt, knt )41 SUBROUTINE p4z_sed( kt, knt, Kbb, Kmm, Krhs ) 42 42 !!--------------------------------------------------------------------- 43 43 !! *** ROUTINE p4z_sed *** … … 51 51 ! 52 52 INTEGER, INTENT(in) :: kt, knt ! ocean time step 53 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 53 54 INTEGER :: ji, jj, jk, ikt 54 55 REAL(wp) :: zrivalk, zrivsil, zrivno3 … … 102 103 DO jj = 1, jpj 103 104 DO ji = 1, jpi 104 zdep = rfact2 / e3t _n(ji,jj,1)105 zdep = rfact2 / e3t(ji,jj,1,Kmm) 105 106 zwflux = fmmflx(ji,jj) / 1000._wp 106 zfminus = MIN( 0._wp, -zwflux ) * tr b(ji,jj,1,jpfer) * zdep107 zfminus = MIN( 0._wp, -zwflux ) * tr(ji,jj,1,jpfer,Kbb) * zdep 107 108 zfplus = MAX( 0._wp, -zwflux ) * icefeinput * zdep 108 109 zironice(ji,jj) = zfplus + zfminus … … 110 111 END DO 111 112 ! 112 tr a(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)113 tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:) 113 114 ! 114 115 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 ice116 & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! iron flux from ice 116 117 ! 117 118 DEALLOCATE( zironice ) … … 126 127 ! ! Iron and Si deposition at the surface 127 128 IF( ln_solub ) THEN 128 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t _n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss129 zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t(:,:,1,Kmm) / 55.85 + 3.e-10 * r1_ryyss 129 130 ELSE 130 zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / e3t _n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss131 ENDIF 132 zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t _n(:,:,1) / 28.1133 zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t _n(:,:,1) / 31. / po4r131 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 134 135 ! ! Iron solubilization of particles in the water column 135 136 ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j 136 137 zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 137 138 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. ) 139 140 zpdep (:,:,jk) = zirondep(:,:,jk) * 0.023 140 141 END DO 141 142 ! ! Iron solubilization of particles in the water column 142 tr a(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:)143 tr(:,:,1,jpsil,Krhs) = tr(:,:,1,jpsil,Krhs) + zsidep (:,:) 143 144 DO jk = 1, jpkm1 144 tr a(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zpdep (:,:,jk)145 tr a(:,:,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) 146 147 ENDDO 147 148 ! … … 149 150 IF( knt == nrdttrc ) THEN 150 151 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 iron152 & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! surface downward dust depo of iron 152 153 IF( iom_use( "pdust" ) ) & 153 154 & CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface … … 164 165 DO ji = 1, jpi 165 166 DO jk = 1, nk_rnf(ji,jj) 166 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2167 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2168 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2169 tr a(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2170 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2171 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2172 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + rivdoc(ji,jj) * rfact2167 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 173 174 ENDDO 174 175 ENDDO … … 178 179 DO ji = 1, jpi 179 180 DO jk = 1, nk_rnf(ji,jj) 180 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + rivdic(ji,jj) * 5.e-5 * rfact2181 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + rivdic(ji,jj) * 5.e-5 * rfact2 181 182 ENDDO 182 183 ENDDO … … 187 188 DO ji = 1, jpi 188 189 DO jk = 1, nk_rnf(ji,jj) 189 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2190 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2190 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 191 192 ENDDO 192 193 ENDDO … … 198 199 ! ---------------------------------------------------------- 199 200 IF( ln_ndepo ) THEN 200 tr a(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2201 tr a(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2201 tr(:,:,1,jpno3,Krhs) = tr(:,:,1,jpno3,Krhs) + nitdep(:,:) * rfact2 202 tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * nitdep(:,:) * rfact2 202 203 ENDIF 203 204 … … 205 206 ! ------------------------------------------------------ 206 207 IF( ln_hydrofe ) THEN 207 tr a(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2208 tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + hydrofe(:,:,:) * rfact2 208 209 IF( ln_ligand ) THEN 209 tr a(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2210 tr(:,:,:,jplgw,Krhs) = tr(:,:,:,jplgw,Krhs) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 210 211 ENDIF 211 212 ! … … 219 220 DO ji = 1, jpi 220 221 ikt = mbkt(ji,jj) 221 zdep = e3t _n(ji,jj,ikt) / xstep222 zdep = e3t(ji,jj,ikt,Kmm) / xstep 222 223 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) ) 223 224 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) ) … … 230 231 ! ------------------------------------------------------ 231 232 IF( ln_ironsed ) THEN 232 tr a(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2233 tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + ironsed(:,:,:) * rfact2 233 234 ! 234 235 IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) & … … 243 244 IF( tmask(ji,jj,1) == 1 ) THEN 244 245 ikt = mbkt(ji,jj) 245 zflx = ( tr b(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &246 & + tr b(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4246 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 247 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4 247 248 zflx = LOG10( MAX( 1E-3, zflx ) ) 248 zo2 = LOG10( MAX( 10. , tr b(ji,jj,ikt,jpoxy) * 1E6 ) )249 zno3 = LOG10( MAX( 1. , tr b(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) ) 251 252 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 & 252 253 & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 253 254 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 254 255 ! 255 zflx = ( tr b(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &256 & + tr b(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6256 zflx = ( tr(ji,jj,ikt,jpgoc,Kbb) * zwsbio4(ji,jj) & 257 & + tr(ji,jj,ikt,jppoc,Kbb) * zwsbio3(ji,jj) ) * 1E6 257 258 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 258 259 ENDIF … … 270 271 DO ji = 1, jpi 271 272 ikt = mbkt(ji,jj) 272 zdep = xstep / e3t _n(ji,jj,ikt)273 zdep = xstep / e3t(ji,jj,ikt,Kmm) 273 274 zwsc = zwsbio4(ji,jj) * zdep 274 zsiloss = tr b(ji,jj,ikt,jpgsi) * zwsc275 zcaloss = tr b(ji,jj,ikt,jpcal) * zwsc275 zsiloss = tr(ji,jj,ikt,jpgsi,Kbb) * zwsc 276 zcaloss = tr(ji,jj,ikt,jpcal,Kbb) * zwsc 276 277 ! 277 tr a(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss278 tr a(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss278 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 279 280 END DO 280 281 END DO … … 284 285 DO ji = 1, jpi 285 286 ikt = mbkt(ji,jj) 286 zdep = xstep / e3t _n(ji,jj,ikt)287 zdep = xstep / e3t(ji,jj,ikt,Kmm) 287 288 zwsc = zwsbio4(ji,jj) * zdep 288 zsiloss = tr b(ji,jj,ikt,jpgsi) * zwsc289 zcaloss = tr b(ji,jj,ikt,jpcal) * zwsc290 tr a(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil289 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 291 292 ! 292 293 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 293 294 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 294 295 zrivalk = sedcalfrac * zfactcal 295 tr a(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0296 tr a(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk297 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) 299 300 END DO 300 301 END DO … … 304 305 DO ji = 1, jpi 305 306 ikt = mbkt(ji,jj) 306 zdep = xstep / e3t _n(ji,jj,ikt)307 zdep = xstep / e3t(ji,jj,ikt,Kmm) 307 308 zws4 = zwsbio4(ji,jj) * zdep 308 309 zws3 = zwsbio3(ji,jj) * zdep 309 tr a(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4310 tr a(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3311 tr a(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4312 tr a(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3310 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 313 314 END DO 314 315 END DO … … 318 319 DO ji = 1, jpi 319 320 ikt = mbkt(ji,jj) 320 zdep = xstep / e3t _n(ji,jj,ikt)321 zdep = xstep / e3t(ji,jj,ikt,Kmm) 321 322 zws4 = zwsbio4(ji,jj) * zdep 322 323 zws3 = zwsbio3(ji,jj) * zdep 323 tr a(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4324 tr a(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3325 tr a(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4326 tr a(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3324 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 327 328 END DO 328 329 END DO … … 335 336 DO ji = 1, jpi 336 337 ikt = mbkt(ji,jj) 337 zdep = xstep / e3t _n(ji,jj,ikt)338 zdep = xstep / e3t(ji,jj,ikt,Kmm) 338 339 zws4 = zwsbio4(ji,jj) * zdep 339 340 zws3 = zwsbio3(ji,jj) * zdep 340 341 zrivno3 = 1. - zbureff(ji,jj) 341 zwstpoc = tr b(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3342 zpdenit = MIN( 0.5 * ( tr b(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 ) 343 344 z1pdenit = zwstpoc * zrivno3 - zpdenit 344 zolimit = MIN( ( tr b(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )345 tr a(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit346 tr a(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit347 tr a(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit348 tr a(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit349 tr a(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut350 tr a(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit )351 tr a(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit352 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) 354 355 IF( ln_p5z ) THEN 355 zwstpop = tr b(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3356 zwstpon = tr b(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3357 tr a(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + ( z1pdenit - zolimit ) * zwstpon / (zwstpoc + rtrn)358 tr a(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) 359 360 ENDIF 360 361 END DO … … 375 376 DO ji = 1, jpi 376 377 ! ! Potential nitrogen fixation dependant on temperature and iron 377 ztemp = ts n(ji,jj,jk,jp_tem)378 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 378 379 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 379 380 ! Potential nitrogen fixation dependant on temperature and iron 380 xdianh4 = tr b(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) )381 xdiano3 = tr b(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) 382 383 zlim = ( 1.- xdiano3 - xdianh4 ) 383 384 IF( zlim <= 0.1 ) zlim = 0.01 384 385 zfact = zlim * rfact2 385 386 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 386 ztrpo4(ji,jj,jk) = tr b(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) ) 387 388 ztrdp = ztrpo4(ji,jj,jk) 388 389 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) … … 395 396 DO ji = 1, jpi 396 397 ! ! Potential nitrogen fixation dependant on temperature and iron 397 ztemp = ts n(ji,jj,jk,jp_tem)398 ztemp = ts(ji,jj,jk,jp_tem,Kmm) 398 399 zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 399 400 ! Potential nitrogen fixation dependant on temperature and iron 400 xdianh4 = tr b(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) )401 xdiano3 = tr b(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) 402 403 zlim = ( 1.- xdiano3 - xdianh4 ) 403 404 IF( zlim <= 0.1 ) zlim = 0.01 404 405 zfact = zlim * rfact2 405 406 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 406 ztrpo4(ji,jj,jk) = tr b(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) )407 ztrdop(ji,jj,jk) = tr b(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)) 408 409 ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 409 410 nitrpot(ji,jj,jk) = zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) … … 420 421 DO ji = 1, jpi 421 422 zfact = nitrpot(ji,jj,jk) * nitrfix 422 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0423 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0424 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zfact * 2.0 / 3.0425 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0426 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0427 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0428 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0429 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0430 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0431 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0432 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday433 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &434 & * 0.001 * tr b(ji,jj,jk,jpdoc) * xstep423 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 435 436 END DO 436 437 END DO … … 441 442 DO ji = 1, jpi 442 443 zfact = nitrpot(ji,jj,jk) * nitrfix 443 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0444 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0445 tr a(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 ) & 446 447 & * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 447 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0448 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0449 tr a(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 & 450 451 & - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk) & 451 452 & / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 452 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0453 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0454 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0455 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0456 tr a(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0457 tr a(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0458 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0459 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0460 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0461 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0462 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday453 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 463 464 END DO 464 465 END DO … … 474 475 zwork(:,:) = 0. 475 476 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) 477 478 ENDDO 478 479 CALL iom_put( "INTNFIX" , zwork ) … … 488 489 WRITE(charout, fmt="('sed ')") 489 490 CALL prt_ctl_trc_info(charout) 490 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)491 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 491 492 ENDIF 492 493 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsink.F90
r10966 r10975 49 49 !!---------------------------------------------------------------------- 50 50 51 SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm )51 SUBROUTINE p4z_sink ( kt, knt, Kbb, Kmm, Krhs ) 52 52 !!--------------------------------------------------------------------- 53 53 !! *** ROUTINE p4z_sink *** … … 59 59 !!--------------------------------------------------------------------- 60 60 INTEGER, INTENT(in) :: kt, knt 61 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices61 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 62 62 INTEGER :: ji, jj, jk 63 63 CHARACTER (len=25) :: charout … … 84 84 DO ji = 1,jpi 85 85 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 86 zfact = MAX( 0., gdepw _n(ji,jj,jk+1) - zmax ) / wsbio2scale86 zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale 87 87 wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 88 88 END DO … … 176 176 WRITE(charout, FMT="('sink')") 177 177 CALL prt_ctl_trc_info(charout) 178 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)178 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 179 179 ENDIF 180 180 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90
r10966 r10975 46 46 CONTAINS 47 47 48 SUBROUTINE p4z_sms( kt, Kbb, Kmm )48 SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** ROUTINE p4z_sms *** … … 58 58 !!--------------------------------------------------------------------- 59 59 ! 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index61 INTEGER, INTENT( in ) :: Kbb, Kmm 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 62 62 !! 63 63 INTEGER :: ji, jj, jk, jnt, jn, jl … … 73 73 ! 74 74 IF( .NOT. ln_rsttr ) THEN 75 CALL p4z_che 76 CALL ahini_for_at( hi)! set PH at kt=nit00075 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 76 CALL ahini_for_at( hi, Kbb ) ! set PH at kt=nit000 77 77 t_oce_co2_flx_cum = 0._wp 78 78 ELSE 79 CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields79 CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields 80 80 ENDIF 81 81 ! 82 82 ENDIF 83 83 ! 84 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers84 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers 85 85 ! 86 86 rfact = r2dttrc … … 99 99 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 100 100 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 101 tr b(:,:,:,jn) = trn(:,:,:,jn)101 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 102 102 END DO 103 103 ENDIF 104 104 ! 105 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients105 IF( ll_sbc ) CALL p4z_sbc( kt, Kmm ) ! external sources of nutrients 106 106 ! 107 107 #if ! defined key_sed_off 108 CALL p4z_che 109 CALL p4z_int( kt )! computation of various rates for biogeochemistry108 CALL p4z_che( Kbb, Kmm ) ! computation of chemical constants 109 CALL p4z_int( kt, Kbb, Kmm ) ! computation of various rates for biogeochemistry 110 110 ! 111 111 DO jnt = 1, nrdttrc ! Potential time splitting if requested 112 112 ! 113 CALL p4z_bio( kt, jnt, Kbb, Kmm ) ! Biology114 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation115 CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions116 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes113 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 117 117 ! 118 118 xnegtr(:,:,:) = 1.e0 … … 121 121 DO jj = 1, jpj 122 122 DO ji = 1, jpi 123 IF( ( tr b(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN124 ztra = ABS( tr b(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 ) 125 125 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 126 126 ENDIF … … 132 132 ! ! 133 133 DO jn = jp_pcs0, jp_pcs1 134 tr b(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)134 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 135 135 END DO 136 136 ! 137 137 DO jn = jp_pcs0, jp_pcs1 138 tr a(:,:,:,jn) = 0._wp138 tr(:,:,:,jn,Krhs) = 0._wp 139 139 END DO 140 140 ! 141 141 IF( ln_top_euler ) THEN 142 142 DO jn = jp_pcs0, jp_pcs1 143 tr n(:,:,:,jn) = trb(:,:,:,jn)143 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 144 144 END DO 145 145 ENDIF … … 149 149 IF( l_trdtrc ) THEN 150 150 DO jn = jp_pcs0, jp_pcs1 151 CALL trd_trc( tr a(:,:,:,jn), jn, jptra_sms, kt, Kmm ) ! save trends151 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 152 152 END DO 153 153 END IF … … 156 156 IF( ln_sediment ) THEN 157 157 ! 158 CALL sed_model( kt, K mm) ! Main program of Sediment model158 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 159 159 ! 160 160 IF( ln_top_euler ) THEN 161 161 DO jn = jp_pcs0, jp_pcs1 162 tr n(:,:,:,jn) = trb(:,:,:,jn)162 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 163 163 END DO 164 164 ENDIF … … 166 166 ENDIF 167 167 ! 168 IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' )!* Write PISCES informations in restart file169 ! 170 171 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt )! Mass conservation checking172 173 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES168 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 174 174 ! 175 175 IF( ln_timing ) CALL timing_stop('p4z_sms') … … 265 265 266 266 267 SUBROUTINE p4z_rst( kt, cdrw )267 SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 268 268 !!--------------------------------------------------------------------- 269 269 !! *** ROUTINE p4z_rst *** … … 276 276 !!--------------------------------------------------------------------- 277 277 INTEGER , INTENT(in) :: kt ! ocean time-step 278 INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices 278 279 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 279 280 !!--------------------------------------------------------------------- … … 288 289 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 289 290 ELSE 290 CALL p4z_che 291 CALL ahini_for_at( hi)291 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 292 CALL ahini_for_at( hi, Kbb ) 292 293 ENDIF 293 294 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) … … 336 337 337 338 338 SUBROUTINE p4z_dmp( kt )339 SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 339 340 !!---------------------------------------------------------------------- 340 341 !! *** p4z_dmp *** … … 343 344 !!---------------------------------------------------------------------- 344 345 ! 345 INTEGER, INTENT( in ) :: kt ! time step 346 INTEGER, INTENT( in ) :: kt ! time step 347 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 346 348 ! 347 349 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 364 366 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 365 367 366 zalksumn = glob_sum( 'p4zsms', tr n(:,:,:,jptal) * cvol(:,:,:) ) * zarea367 zpo4sumn = glob_sum( 'p4zsms', tr n(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r368 zno3sumn = glob_sum( 'p4zsms', tr n(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3369 zsilsumn = glob_sum( 'p4zsms', tr n(:,:,:,jpsil) * cvol(:,:,:) ) * zarea368 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 370 372 371 373 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 372 tr n(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn374 tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 373 375 374 376 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 375 tr n(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn377 tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 376 378 377 379 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 378 tr n(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn380 tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 379 381 380 382 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 381 tr n(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )383 tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 382 384 ! 383 385 ! 384 386 IF( .NOT. ln_top_euler ) THEN 385 zalksumb = glob_sum( 'p4zsms', tr b(:,:,:,jptal) * cvol(:,:,:) ) * zarea386 zpo4sumb = glob_sum( 'p4zsms', tr b(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r387 zno3sumb = glob_sum( 'p4zsms', tr b(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3388 zsilsumb = glob_sum( 'p4zsms', tr b(:,:,:,jpsil) * cvol(:,:,:) ) * zarea387 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 389 391 390 392 IF(lwp) WRITE(numout,*) ' ' 391 393 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 392 tr b(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb394 tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 393 395 394 396 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 395 tr b(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb397 tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 396 398 397 399 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 398 tr b(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb400 tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 399 401 400 402 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 401 tr b(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )403 tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 402 404 ENDIF 403 405 ENDIF … … 408 410 409 411 410 SUBROUTINE p4z_chk_mass( kt )412 SUBROUTINE p4z_chk_mass( kt, Kmm ) 411 413 !!---------------------------------------------------------------------- 412 414 !! *** ROUTINE p4z_chk_mass *** … … 416 418 !!--------------------------------------------------------------------- 417 419 INTEGER, INTENT( in ) :: kt ! ocean time-step index 420 INTEGER, INTENT( in ) :: Kmm ! time level indices 418 421 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 419 422 CHARACTER(LEN=100) :: cltxt … … 439 442 ! Compute the budget of NO3, ALK, Si, Fer 440 443 IF( ln_p4z ) THEN 441 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) &442 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &443 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &444 & + tr n(:,:,:,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) 445 448 ELSE 446 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) &447 & + tr n(:,:,:,jpndi) + trn(:,:,:,jpnpi) &448 & + tr n(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) &449 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3449 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 450 453 ENDIF 451 454 ! … … 457 460 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 458 461 IF( ln_p4z ) THEN 459 zwork(:,:,:) = tr n(:,:,:,jppo4) &460 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &461 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &462 & + tr n(:,:,:,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) 463 466 ELSE 464 zwork(:,:,:) = tr n(:,:,:,jppo4) + trn(:,:,:,jppph) &465 & + tr n(:,:,:,jppdi) + trn(:,:,:,jpppi) &466 & + tr n(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) &467 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3467 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 468 471 ENDIF 469 472 ! … … 474 477 ! 475 478 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 476 zwork(:,:,:) = tr n(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)479 zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm) 477 480 ! 478 481 silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) … … 482 485 ! 483 486 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 484 zwork(:,:,:) = tr n(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.487 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2. 485 488 ! 486 489 alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) ! … … 490 493 ! 491 494 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 492 zwork(:,:,:) = tr n(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) &493 & + tr n(:,:,:,jpbfe) + trn(:,:,:,jpsfe) &494 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3495 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 495 498 ! 496 499 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 99 99 CONTAINS 100 100 101 SUBROUTINE p5z_lim( kt, knt )101 SUBROUTINE p5z_lim( kt, knt, Kbb, Kmm ) 102 102 !!--------------------------------------------------------------------- 103 103 !! *** ROUTINE p5z_lim *** … … 110 110 ! 111 111 INTEGER, INTENT(in) :: kt, knt 112 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 112 113 ! 113 114 INTEGER :: ji, jj, jk … … 134 135 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 135 136 !------------------------------------- 136 zno3 = tr b(ji,jj,jk,jpno3) / 40.e-6137 zno3 = tr(ji,jj,jk,jpno3,Kbb) / 40.e-6 137 138 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 138 139 zferlim = MIN( zferlim, 7e-11 ) 139 tr b(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 ) 140 141 141 142 ! Computation of the mean relative size of each community 142 143 ! ------------------------------------------------------- 143 z1_trnphy = 1. / ( tr b(ji,jj,jk,jpphy) + rtrn )144 z1_trnpic = 1. / ( tr b(ji,jj,jk,jppic) + rtrn )145 z1_trndia = 1. / ( tr b(ji,jj,jk,jpdia) + rtrn )146 znanochl = tr b(ji,jj,jk,jpnch) * z1_trnphy147 zpicochl = tr b(ji,jj,jk,jppch) * z1_trnpic148 zdiatchl = tr b(ji,jj,jk,jpdch) * z1_trndia144 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 149 150 150 151 ! Computation of a variable Ks for iron on diatoms taking into account … … 182 183 ! Based on the different papers by Pahlow et al., and Smith et al. 183 184 ! ----------------------------------------------------------------- 184 znutlim = MAX( tr b(ji,jj,jk,jpnh4) / zconc0nnh4, &185 & tr b(ji,jj,jk,jpno3) / zconc0n)185 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0nnh4, & 186 & tr(ji,jj,jk,jpno3,Kbb) / zconc0n) 186 187 fanano = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 187 znutlim = tr b(ji,jj,jk,jppo4) / zconc0npo4188 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0npo4 188 189 fananop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 189 190 znutlim = biron(ji,jj,jk) / zconcnfe 190 191 fananof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 191 znutlim = MAX( tr b(ji,jj,jk,jpnh4) / zconc0pnh4, &192 & tr b(ji,jj,jk,jpno3) / zconc0p)192 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc0pnh4, & 193 & tr(ji,jj,jk,jpno3,Kbb) / zconc0p) 193 194 fapico = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 194 znutlim = tr b(ji,jj,jk,jppo4) / zconc0ppo4195 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0ppo4 195 196 fapicop = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 196 197 znutlim = biron(ji,jj,jk) / zconcpfe 197 198 fapicof = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 198 znutlim = MAX( tr b(ji,jj,jk,jpnh4) / zconc1dnh4, &199 & tr b(ji,jj,jk,jpno3) / zconc1d )199 znutlim = MAX( tr(ji,jj,jk,jpnh4,Kbb) / zconc1dnh4, & 200 & tr(ji,jj,jk,jpno3,Kbb) / zconc1d ) 200 201 fadiat = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 201 znutlim = tr b(ji,jj,jk,jppo4) / zconc0dpo4202 znutlim = tr(ji,jj,jk,jppo4,Kbb) / zconc0dpo4 202 203 fadiatp = MAX(0.01, MIN(0.99, 1. / ( SQRT(znutlim) + 1.) ) ) 203 204 znutlim = biron(ji,jj,jk) / zconcdfe … … 206 207 ! Michaelis-Menten Limitation term for nutrients Small bacteria 207 208 ! ------------------------------------------------------------- 208 zbactnh4 = tr b(ji,jj,jk,jpnh4) / ( concbnh4 + trb(ji,jj,jk,jpnh4) )209 zbactno3 = tr b(ji,jj,jk,jpno3) / ( concbno3 + trb(ji,jj,jk,jpno3) ) * (1. - zbactnh4)209 zbactnh4 = tr(ji,jj,jk,jpnh4,Kbb) / ( concbnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 210 zbactno3 = tr(ji,jj,jk,jpno3,Kbb) / ( concbno3 + tr(ji,jj,jk,jpno3,Kbb) ) * (1. - zbactnh4) 210 211 ! 211 212 zlim1 = zbactno3 + zbactnh4 212 zlim2 = tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbpo4)213 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concbpo4) 213 214 zlim3 = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 214 zlim4 = tr b(ji,jj,jk,jpdoc) / ( xkdoc + trb(ji,jj,jk,jpdoc) )215 zlim4 = tr(ji,jj,jk,jpdoc,Kbb) / ( xkdoc + tr(ji,jj,jk,jpdoc,Kbb) ) 215 216 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 216 217 xlimbac (ji,jj,jk) = xlimbacl(ji,jj,jk) * zlim4 … … 219 220 ! ----------------------------------------------- 220 221 zfalim = (1.-fanano) / fanano 221 xnanonh4(ji,jj,jk) = (1. - fanano) * tr b(ji,jj,jk,jpnh4) / ( zfalim * zconc0nnh4 + trb(ji,jj,jk,jpnh4) )222 xnanono3(ji,jj,jk) = (1. - fanano) * tr b(ji,jj,jk,jpno3) / ( zfalim * zconc0n + trb(ji,jj,jk,jpno3) ) &222 xnanonh4(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0nnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 223 xnanono3(ji,jj,jk) = (1. - fanano) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0n + tr(ji,jj,jk,jpno3,Kbb) ) & 223 224 & * (1. - xnanonh4(ji,jj,jk)) 224 225 ! 225 226 zfalim = (1.-fananop) / fananop 226 xnanopo4(ji,jj,jk) = (1. - fananop) * tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0npo4 )227 xnanodop(ji,jj,jk) = tr b(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc ) &227 xnanopo4(ji,jj,jk) = (1. - fananop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0npo4 ) 228 xnanodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 228 229 & * ( 1.0 - xnanopo4(ji,jj,jk) ) 229 230 xnanodop(ji,jj,jk) = 0. … … 232 233 xnanofer(ji,jj,jk) = (1. - fananof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcnfe ) 233 234 ! 234 zratiof = tr b(ji,jj,jk,jpnfe) * z1_trnphy235 zratiof = tr(ji,jj,jk,jpnfe,Kbb) * z1_trnphy 235 236 zqfemn = xcoef1 * znanochl + xcoef2 + xcoef3 * xnanono3(ji,jj,jk) 236 237 ! 237 zration = tr b(ji,jj,jk,jpnph) * z1_trnphy238 zration = tr(ji,jj,jk,jpnph,Kbb) * z1_trnphy 238 239 zration = MIN(xqnnmax(ji,jj,jk), MAX( 2. * xqnnmin(ji,jj,jk), zration )) 239 240 fvnuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnnmin(ji,jj,jk) / (zration + rtrn) & … … 250 251 ! ---------------------------------------------------------------- 251 252 zfalim = (1.-fapico) / fapico 252 xpiconh4(ji,jj,jk) = (1. - fapico) * tr b(ji,jj,jk,jpnh4) / ( zfalim * zconc0pnh4 + trb(ji,jj,jk,jpnh4) )253 xpicono3(ji,jj,jk) = (1. - fapico) * tr b(ji,jj,jk,jpno3) / ( zfalim * zconc0p + trb(ji,jj,jk,jpno3) ) &253 xpiconh4(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc0pnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 254 xpicono3(ji,jj,jk) = (1. - fapico) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc0p + tr(ji,jj,jk,jpno3,Kbb) ) & 254 255 & * (1. - xpiconh4(ji,jj,jk)) 255 256 ! 256 257 zfalim = (1.-fapicop) / fapicop 257 xpicopo4(ji,jj,jk) = (1. - fapicop) * tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0ppo4 )258 xpicodop(ji,jj,jk) = tr b(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc ) &258 xpicopo4(ji,jj,jk) = (1. - fapicop) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0ppo4 ) 259 xpicodop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 259 260 & * ( 1.0 - xpicopo4(ji,jj,jk) ) 260 261 xpicodop(ji,jj,jk) = 0. … … 263 264 xpicofer(ji,jj,jk) = (1. - fapicof) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcpfe ) 264 265 ! 265 zratiof = tr b(ji,jj,jk,jppfe) * z1_trnpic266 zratiof = tr(ji,jj,jk,jppfe,Kbb) * z1_trnpic 266 267 zqfemp = xcoef1 * zpicochl + xcoef2 + xcoef3 * xpicono3(ji,jj,jk) 267 268 ! 268 zration = tr b(ji,jj,jk,jpnpi) * z1_trnpic269 zration = tr(ji,jj,jk,jpnpi,Kbb) * z1_trnpic 269 270 zration = MIN(xqnpmax(ji,jj,jk), MAX( 2. * xqnpmin(ji,jj,jk), zration )) 270 271 fvpuptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqnpmin(ji,jj,jk) / (zration + rtrn) & … … 281 282 ! ------------------------------------------------------ 282 283 zfalim = (1.-fadiat) / fadiat 283 xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr b(ji,jj,jk,jpnh4) / ( zfalim * zconc1dnh4 + trb(ji,jj,jk,jpnh4) )284 xdiatno3(ji,jj,jk) = (1. - fadiat) * tr b(ji,jj,jk,jpno3) / ( zfalim * zconc1d + trb(ji,jj,jk,jpno3) ) &284 xdiatnh4(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpnh4,Kbb) / ( zfalim * zconc1dnh4 + tr(ji,jj,jk,jpnh4,Kbb) ) 285 xdiatno3(ji,jj,jk) = (1. - fadiat) * tr(ji,jj,jk,jpno3,Kbb) / ( zfalim * zconc1d + tr(ji,jj,jk,jpno3,Kbb) ) & 285 286 & * (1. - xdiatnh4(ji,jj,jk)) 286 287 ! 287 288 zfalim = (1.-fadiatp) / fadiatp 288 xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zfalim * zconc0dpo4 )289 xdiatdop(ji,jj,jk) = tr b(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdop) + xkdoc ) &289 xdiatpo4(ji,jj,jk) = (1. - fadiatp) * tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + zfalim * zconc0dpo4 ) 290 xdiatdop(ji,jj,jk) = tr(ji,jj,jk,jpdop,Kbb) / ( tr(ji,jj,jk,jpdop,Kbb) + xkdoc ) & 290 291 & * ( 1.0 - xdiatpo4(ji,jj,jk) ) 291 292 xdiatdop(ji,jj,jk) = 0. … … 294 295 xdiatfer(ji,jj,jk) = (1. - fadiatf) * biron(ji,jj,jk) / ( biron(ji,jj,jk) + zfalim * zconcdfe ) 295 296 ! 296 zratiof = tr b(ji,jj,jk,jpdfe) * z1_trndia297 zratiof = tr(ji,jj,jk,jpdfe,Kbb) * z1_trndia 297 298 zqfemd = xcoef1 * zdiatchl + xcoef2 + xcoef3 * xdiatno3(ji,jj,jk) 298 299 ! 299 zration = tr b(ji,jj,jk,jpndi) * z1_trndia300 zration = tr(ji,jj,jk,jpndi,Kbb) * z1_trndia 300 301 zration = MIN(xqndmax(ji,jj,jk), MAX( 2. * xqndmin(ji,jj,jk), zration )) 301 302 fvduptk(ji,jj,jk) = 1. / zpsiuptk * rno3 * 2. * xqndmin(ji,jj,jk) / (zration + rtrn) & … … 305 306 & / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) ) & 306 307 & * xqndmax(ji,jj,jk) / (zration + rtrn) 307 zlim3 = tr b(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) )308 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) ) 308 309 zlim4 = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 309 310 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) … … 330 331 ! ------------------------------ 331 332 zfuptk = 0.23 * zfvn 332 zrpho = 2.24 * tr b(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpnph) * rno3 * 15. + rtrn )333 zrpho = 2.24 * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpnph,Kbb) * rno3 * 15. + rtrn ) 333 334 zrass = 1. - 0.2 - zrpho - zfuptk 334 335 xqpnmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 335 xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr b(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) + 0.13336 xqpnmax(ji,jj,jk) = xqpnmax(ji,jj,jk) * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) + 0.13 336 337 xqpnmin(ji,jj,jk) = 0.13 + 0.23 * 0.0128 * 16. 337 338 … … 344 345 ! ------------------------------ 345 346 zfuptk = 0.35 * zfvn 346 zrpho = 2.24 * tr b(ji,jj,jk,jppch) / ( trb(ji,jj,jk,jpnpi) * rno3 * 15. + rtrn )347 zrpho = 2.24 * tr(ji,jj,jk,jppch,Kbb) / ( tr(ji,jj,jk,jpnpi,Kbb) * rno3 * 15. + rtrn ) 347 348 zrass = 1. - 0.4 - zrpho - zfuptk 348 349 xqppmax(ji,jj,jk) = (zrpho + zfuptk) * 0.0128 * 16. + zrass * 1./ 9. * 16. 349 xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr b(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn ) + 0.13350 xqppmax(ji,jj,jk) = xqppmax(ji,jj,jk) * tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) + 0.13 350 351 xqppmin(ji,jj,jk) = 0.13 351 352 … … 354 355 zfvn = 2. * fvduptk(ji,jj,jk) 355 356 sized(ji,jj,jk) = MAX(1., MIN(xsizerd, 1.0 / ( MAX(rtrn, zfvn) ) ) ) 356 zcoef = tr b(ji,jj,jk,jpdia) - MIN(xsizedia, trb(ji,jj,jk,jpdia) )357 zcoef = tr(ji,jj,jk,jpdia,Kbb) - MIN(xsizedia, tr(ji,jj,jk,jpdia,Kbb) ) 357 358 sized(ji,jj,jk) = 1. + xsizerd * zcoef *1E6 / ( 1. + zcoef * 1E6 ) 358 359 … … 360 361 ! -------------------- 361 362 zfuptk = 0.2 * zfvn 362 zrpho = 2.24 * tr b(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpndi) * rno3 * 15. + rtrn )363 zrpho = 2.24 * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpndi,Kbb) * rno3 * 15. + rtrn ) 363 364 zrass = 1. - 0.2 - zrpho - zfuptk 364 365 xqpdmax(ji,jj,jk) = ( zfuptk + zrpho ) * 0.0128 * 16. + zrass * 1./ 7.2 * 16. 365 xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr b(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn ) + 0.13366 xqpdmax(ji,jj,jk) = xqpdmax(ji,jj,jk) * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) + 0.13 366 367 xqpdmin(ji,jj,jk) = 0.13 + 0.2 * 0.0128 * 16. 367 368 … … 375 376 DO jj = 1, jpj 376 377 DO ji = 1, jpi 377 zlim1 = tr b(ji,jj,jk,jpnh4) / ( trb(ji,jj,jk,jpnh4) + concnnh4 ) + trb(ji,jj,jk,jpno3) &378 & / ( tr b(ji,jj,jk,jpno3) + concnno3 ) * ( 1.0 - trb(ji,jj,jk,jpnh4) &379 & / ( tr b(ji,jj,jk,jpnh4) + concnnh4 ) )380 zlim2 = tr b(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnpo4 )381 zlim3 = tr b(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 5.E-11 )382 ztem1 = MAX( 0., ts n(ji,jj,jk,jp_tem) )383 ztem2 = ts n(ji,jj,jk,jp_tem) - 10.378 zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) & 379 & / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) & 380 & / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) ) 381 zlim2 = tr(ji,jj,jk,jppo4,Kbb) / ( tr(ji,jj,jk,jppo4,Kbb) + concnpo4 ) 382 zlim3 = tr(ji,jj,jk,jpfer,Kbb) / ( tr(ji,jj,jk,jpfer,Kbb) + 5.E-11 ) 383 ztem1 = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) ) 384 ztem2 = ts(ji,jj,jk,jp_tem,Kmm) - 10. 384 385 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) * 20. / ( 20. + etot(ji,jj,jk) ) 385 386 386 387 ! xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 387 388 xfracal(ji,jj,jk) = caco3r & 388 & * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr b(ji,jj,jk,jpphy)*1E6 ) &389 & * ztem1 / ( 1. + ztem1 ) * MAX( 1., tr(ji,jj,jk,jpphy,Kbb)*1E6 ) & 389 390 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 390 391 & * zetot1 * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) … … 398 399 DO ji = 1, jpi 399 400 ! denitrification factor computed from O2 levels 400 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr b(ji,jj,jk,jpoxy) ) &401 & / ( oxymin + tr b(ji,jj,jk,jpoxy) ) )401 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & 402 & / ( oxymin + tr(ji,jj,jk,jpoxy,Kbb) ) ) 402 403 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 403 404 END DO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmeso.F90
r10362 r10975 59 59 CONTAINS 60 60 61 SUBROUTINE p5z_meso( kt, knt )61 SUBROUTINE p5z_meso( kt, knt, Kbb, Krhs ) 62 62 !!--------------------------------------------------------------------- 63 63 !! *** ROUTINE p5z_meso *** … … 67 67 !! ** Method : - ??? 68 68 !!--------------------------------------------------------------------- 69 INTEGER, INTENT(in) :: kt, knt ! ocean time step 69 INTEGER, INTENT(in) :: kt, knt ! ocean time step 70 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 70 71 INTEGER :: ji, jj, jk 71 72 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames … … 108 109 DO jj = 1, jpj 109 110 DO ji = 1, jpi 110 zcompam = MAX( ( tr b(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )111 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 111 112 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam 112 113 113 114 ! Michaelis-Menten mortality rates of mesozooplankton 114 115 ! --------------------------------------------------- 115 zrespz = resrat2 * zfact * ( tr b(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) ) &116 zrespz = resrat2 * zfact * ( tr(ji,jj,jk,jpmes,Kbb) / ( xkmort + tr(ji,jj,jk,jpmes,Kbb) ) & 116 117 & + 3. * nitrfac(ji,jj,jk) ) 117 118 … … 119 120 ! no real reason except that it seems to be more stable and may mimic predation 120 121 ! --------------------------------------------------------------- 121 ztortz = mzrat2 * 1.e6 * zfact * tr b(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))122 ztortz = mzrat2 * 1.e6 * zfact * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 122 123 123 124 ! Computation of the abundance of the preys 124 125 ! A threshold can be specified in the namelist 125 126 ! -------------------------------------------- 126 zcompadi = MAX( ( tr b(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )127 zcompaz = MAX( ( tr b(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )128 zcompaph = MAX( ( tr b(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 )129 zcompapoc = MAX( ( tr b(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )130 zcompames = MAX( ( tr b(ji,jj,jk,jpmes) - xthresh2mes ), 0.e0 )127 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthresh2dia ), 0.e0 ) 128 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthresh2zoo ), 0.e0 ) 129 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthresh2phy ), 0.e0 ) 130 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthresh2poc ), 0.e0 ) 131 zcompames = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - xthresh2mes ), 0.e0 ) 131 132 132 133 ! Mesozooplankton grazing … … 136 137 zfoodlim = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 137 138 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 138 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr b(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))139 zgraze2 = grazrat2 * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpmes,Kbb) * (1. - nitrfac(ji,jj,jk)) 139 140 140 141 ! An active switching parameterization is used here. … … 161 162 ! ------------------------------------------------------ 162 163 zgrazdc = zgraze2 * ztmp4 * zdenom 163 zgrazdn = zgrazdc * tr b(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn)164 zgrazdp = zgrazdc * tr b(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn)165 zgrazdf = zgrazdc * tr b(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)164 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 165 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 166 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn) 166 167 zgrazz = zgraze2 * ztmp5 * zdenom 167 168 zgrazm = zgraze2 * ztmp2 * zdenom 168 169 zgraznc = zgraze2 * ztmp1 * zdenom 169 zgraznn = zgraznc * tr b(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn)170 zgraznp = zgraznc * tr b(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn)171 zgraznf = zgraznc * tr b(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)170 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 171 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 172 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn) 172 173 zgrazpoc = zgraze2 * ztmp3 * zdenom 173 zgrazpon = zgrazpoc * tr b(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)174 zgrazpop = zgrazpoc * tr b(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)175 zgrazpof = zgrazpoc * tr b(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)174 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 175 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 176 zgrazpof = zgrazpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn) 176 177 177 178 ! Mesozooplankton flux feeding on GOC 178 179 ! ---------------------------------- 179 180 zgrazffeg = grazflux * xstep * wsbio4(ji,jj,jk) & 180 & * tgfunc2(ji,jj,jk) * tr b(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) &181 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 181 182 & * (1. - nitrfac(ji,jj,jk)) 182 zgrazfffg = zgrazffeg * tr b(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)183 zgrazffng = zgrazffeg * tr b(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn)184 zgrazffpg = zgrazffeg * tr b(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn)183 zgrazfffg = zgrazffeg * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 184 zgrazffng = zgrazffeg * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 185 zgrazffpg = zgrazffeg * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 185 186 zgrazffep = grazflux * xstep * wsbio3(ji,jj,jk) & 186 & * tgfunc2(ji,jj,jk) * tr b(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) &187 & * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 187 188 & * (1. - nitrfac(ji,jj,jk)) 188 zgrazfffp = zgrazffep * tr b(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)189 zgrazffnp = zgrazffep * tr b(ji,jj,jk,jppon) / (trb(ji,jj,jk,jppoc) + rtrn)190 zgrazffpp = zgrazffep * tr b(ji,jj,jk,jppop) / (trb(ji,jj,jk,jppoc) + rtrn)189 zgrazfffp = zgrazffep * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 190 zgrazffnp = zgrazffep * tr(ji,jj,jk,jppon,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 191 zgrazffpp = zgrazffep * tr(ji,jj,jk,jppop,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 191 192 ! 192 193 zgraztotc = zgrazdc + zgrazz + zgraznc + zgrazm + zgrazpoc + zgrazffep + zgrazffeg … … 200 201 ! since they are more porous (marine snow instead of fecal pellets) 201 202 ! ---------------------------------------------------------------- 202 zratio = tr b(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )203 zratio = tr(ji,jj,jk,jpgsi,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 203 204 zratio2 = zratio * zratio 204 205 zfracc = zproport * grazflux * xstep * wsbio4(ji,jj,jk) & 205 & * tr b(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) &206 & * tr(ji,jj,jk,jpgoc,Kbb) * tr(ji,jj,jk,jpmes,Kbb) & 206 207 & * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 207 zfracfe = zfracc * tr b(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)208 zfracn = zfracc * tr b(ji,jj,jk,jpgon) / (trb(ji,jj,jk,jpgoc) + rtrn)209 zfracp = zfracc * tr b(ji,jj,jk,jpgop) / (trb(ji,jj,jk,jpgoc) + rtrn)208 zfracfe = zfracc * tr(ji,jj,jk,jpbfe,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 209 zfracn = zfracc * tr(ji,jj,jk,jpgon,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 210 zfracp = zfracc * tr(ji,jj,jk,jpgop,Kbb) / (tr(ji,jj,jk,jpgoc,Kbb) + rtrn) 210 211 211 212 zgrazffep = zproport * zgrazffep ; zgrazffeg = zproport * zgrazffeg … … 296 297 ! sinks 297 298 ! -------------------------------------------------------------- 298 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep299 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren300 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc299 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 300 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 301 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 301 302 ! 302 303 IF( ln_ligand ) THEN 303 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz304 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 304 305 zz2ligprod(ji,jj,jk) = zgradoc * ldocz 305 306 ENDIF 306 307 ! 307 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon308 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop309 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem310 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref308 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 309 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 310 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 311 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 311 312 zfezoo2(ji,jj,jk) = zgraref 312 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem313 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren314 tr a(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc &313 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem 314 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgraren 315 tr(ji,jj,jk,jpmes,Krhs) = tr(ji,jj,jk,jpmes,Krhs) + zepsherv * zgraztotc - zrespirc & 315 316 & - ztortz - zgrazm 316 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc317 tr a(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn318 tr a(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp319 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf320 tr a(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz321 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc322 tr a(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn323 tr a(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp324 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf325 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )326 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )327 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )328 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )329 330 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc317 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 318 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 319 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 320 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 321 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zgrazz 322 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 323 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 324 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 325 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 326 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 327 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 328 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 329 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 330 331 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zgrazpoc - zgrazffep + zfracc 331 332 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 332 333 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 333 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn334 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp335 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc334 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zgrazpon - zgrazffnp + zfracn 335 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zgrazpop - zgrazffpp + zfracp 336 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zgrazffeg + zgrapoc - zfracc 336 337 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 337 338 consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 338 tr a(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn339 tr a(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp340 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe341 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe342 zfracal = tr b(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn )339 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zgrazffng + zgrapon - zfracn 340 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zgrazffpg + zgrapop - zfracp 341 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zgrazpof - zgrazfffp + zfracfe 342 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zgrazfffg + zgrapof - zfracfe 343 zfracal = tr(ji,jj,jk,jpcal,Kbb) / ( tr(ji,jj,jk,jpgoc,Kbb) + rtrn ) 343 344 zgrazcal = zgrazffeg * (1. - part2) * zfracal 344 345 … … 348 349 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 349 350 zprcaca = part2 * zprcaca 350 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca351 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca )352 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca351 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrazcal - zprcaca 352 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * ( zgrazcal - zprcaca ) 353 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) - zgrazcal + zprcaca 353 354 END DO 354 355 END DO … … 379 380 WRITE(charout, FMT="('meso')") 380 381 CALL prt_ctl_trc_info(charout) 381 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)382 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 382 383 ENDIF 383 384 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmicro.F90
r10362 r10975 60 60 CONTAINS 61 61 62 SUBROUTINE p5z_micro( kt, knt )62 SUBROUTINE p5z_micro( kt, knt, Kbb, Krhs ) 63 63 !!--------------------------------------------------------------------- 64 64 !! *** ROUTINE p5z_micro *** … … 70 70 INTEGER, INTENT(in) :: kt ! ocean time step 71 71 INTEGER, INTENT(in) :: knt 72 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 72 73 ! 73 74 INTEGER :: ji, jj, jk … … 102 103 DO jj = 1, jpj 103 104 DO ji = 1, jpi 104 zcompaz = MAX( ( tr b(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )105 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 105 106 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz 106 107 107 108 ! Michaelis-Menten mortality rates of microzooplankton 108 109 ! ----------------------------------------------------- 109 zrespz = resrat * zfact * ( tr b(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) ) &110 zrespz = resrat * zfact * ( tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) ) & 110 111 & + 3. * nitrfac(ji,jj,jk) ) 111 112 … … 113 114 ! no real reason except that it seems to be more stable and may mimic predation. 114 115 ! ------------------------------------------------------------------------------ 115 ztortz = mzrat * 1.e6 * zfact * tr b(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))116 ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 116 117 117 118 ! Computation of the abundance of the preys 118 119 ! A threshold can be specified in the namelist 119 120 ! -------------------------------------------- 120 zcompadi = MIN( MAX( ( tr b(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )121 zcompaph = MAX( ( tr b(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )122 zcompaz = MAX( ( tr b(ji,jj,jk,jpzoo) - xthreshzoo ), 0.e0 )123 zcompapi = MAX( ( tr b(ji,jj,jk,jppic) - xthreshpic ), 0.e0 )124 zcompapoc = MAX( ( tr b(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )121 zcompadi = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia ) 122 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 ) 123 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - xthreshzoo ), 0.e0 ) 124 zcompapi = MAX( ( tr(ji,jj,jk,jppic,Kbb) - xthreshpic ), 0.e0 ) 125 zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 ) 125 126 126 127 ! Microzooplankton grazing … … 130 131 zfoodlim = MAX( 0. , zfood - min(xthresh,0.5*zfood) ) 131 132 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 132 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr b(ji,jj,jk,jpzoo) * (1. - nitrfac(ji,jj,jk))133 zgraze = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk)) 133 134 134 135 ! An active switching parameterization is used here. … … 155 156 ! ------------------------------------------------------- 156 157 zgraznc = zgraze * ztmp1 * zdenom 157 zgraznn = zgraznc * tr b(ji,jj,jk,jpnph) / (trb(ji,jj,jk,jpphy) + rtrn)158 zgraznp = zgraznc * tr b(ji,jj,jk,jppph) / (trb(ji,jj,jk,jpphy) + rtrn)159 zgraznf = zgraznc * tr b(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn)158 zgraznn = zgraznc * tr(ji,jj,jk,jpnph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 159 zgraznp = zgraznc * tr(ji,jj,jk,jppph,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 160 zgraznf = zgraznc * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 160 161 zgrazpc = zgraze * ztmp2 * zdenom 161 zgrazpn = zgrazpc * tr b(ji,jj,jk,jpnpi) / (trb(ji,jj,jk,jppic) + rtrn)162 zgrazpp = zgrazpc * tr b(ji,jj,jk,jpppi) / (trb(ji,jj,jk,jppic) + rtrn)163 zgrazpf = zgrazpc * tr b(ji,jj,jk,jppfe) / (trb(ji,jj,jk,jppic) + rtrn)162 zgrazpn = zgrazpc * tr(ji,jj,jk,jpnpi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 163 zgrazpp = zgrazpc * tr(ji,jj,jk,jpppi,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 164 zgrazpf = zgrazpc * tr(ji,jj,jk,jppfe,Kbb) / (tr(ji,jj,jk,jppic,Kbb) + rtrn) 164 165 zgrazz = zgraze * ztmp5 * zdenom 165 166 zgrazpoc = zgraze * ztmp3 * zdenom 166 zgrazpon = zgrazpoc * tr b(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn )167 zgrazpop = zgrazpoc * tr b(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn )168 zgrazpof = zgrazpoc* tr b(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)167 zgrazpon = zgrazpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 168 zgrazpop = zgrazpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 169 zgrazpof = zgrazpoc* tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn) 169 170 zgrazdc = zgraze * ztmp4 * zdenom 170 zgrazdn = zgrazdc * tr b(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn)171 zgrazdp = zgrazdc * tr b(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn)172 zgrazdf = zgrazdc * tr b(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn)171 zgrazdn = zgrazdc * tr(ji,jj,jk,jpndi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 172 zgrazdp = zgrazdc * tr(ji,jj,jk,jppdi,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 173 zgrazdf = zgrazdc * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 173 174 ! 174 175 zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc … … 247 248 ! Update of the TRA arrays 248 249 ! ------------------------ 249 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep250 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren251 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc250 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep 251 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren 252 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgradoc 252 253 ! 253 254 IF( ln_ligand ) THEN 254 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zgradoc * ldocz255 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zgradoc * ldocz 255 256 zzligprod(ji,jj,jk) = zgradoc * ldocz 256 257 ENDIF 257 258 ! 258 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon259 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop260 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem261 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref259 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zgradon 260 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zgradop 261 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarem 262 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgraref 262 263 zfezoo(ji,jj,jk) = zgraref 263 tr a(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz264 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgraznc265 tr a(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zgraznn266 tr a(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zgraznp267 tr a(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zgrazpc268 tr a(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zgrazpn269 tr a(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zgrazpp270 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazdc271 tr a(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zgrazdn272 tr a(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zgrazdp273 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgraznc * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)274 tr a(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zgrazpc * trb(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn)275 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazdc * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn)276 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)277 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazdc * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn)278 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf279 tr a(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zgrazpf280 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazdf281 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortz + zgrapoc - zgrazpoc264 tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) + zepsherv * zgraztotc - zrespirc - ztortz - zgrazz 265 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgraznc 266 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zgraznn 267 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zgraznp 268 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zgrazpc 269 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zgrazpn 270 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zgrazpp 271 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazdc 272 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zgrazdn 273 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zgrazdp 274 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgraznc * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 275 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zgrazpc * tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 276 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazdc * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 277 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 278 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazdc * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn) 279 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgraznf 280 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zgrazpf 281 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazdf 282 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortz + zgrapoc - zgrazpoc 282 283 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortz + zgrapoc 283 284 conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc 284 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + no3rat3 * ztortz + zgrapon - zgrazpon285 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + po4rat3 * ztortz + zgrapop - zgrazpop286 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * ztortz + zgrapof - zgrazpof285 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + no3rat3 * ztortz + zgrapon - zgrazpon 286 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + po4rat3 * ztortz + zgrapop - zgrazpop 287 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * ztortz + zgrapof - zgrazpof 287 288 ! 288 289 ! calcite production … … 291 292 ! 292 293 zprcaca = part * zprcaca 293 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca294 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca &294 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarem - zprcaca 295 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca & 295 296 & + rno3 * zgraren 296 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca297 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 297 298 END DO 298 299 END DO … … 321 322 WRITE(charout, FMT="('micro')") 322 323 CALL prt_ctl_trc_info(charout) 323 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)324 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 324 325 ENDIF 325 326 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmort.F90
r10362 r10975 41 41 CONTAINS 42 42 43 SUBROUTINE p5z_mort( kt )43 SUBROUTINE p5z_mort( kt, Kbb, Krhs ) 44 44 !!--------------------------------------------------------------------- 45 45 !! *** ROUTINE p5z_mort *** … … 51 51 !!--------------------------------------------------------------------- 52 52 INTEGER, INTENT(in) :: kt ! ocean time step 53 !!--------------------------------------------------------------------- 54 55 CALL p5z_nano ! nanophytoplankton 56 CALL p5z_pico ! picophytoplankton 57 CALL p5z_diat ! diatoms 53 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 54 !!--------------------------------------------------------------------- 55 56 CALL p5z_nano( Kbb, Krhs ) ! nanophytoplankton 57 CALL p5z_pico( Kbb, Krhs ) ! picophytoplankton 58 CALL p5z_diat( Kbb, Krhs ) ! diatoms 58 59 59 60 END SUBROUTINE p5z_mort 60 61 61 62 62 SUBROUTINE p5z_nano 63 SUBROUTINE p5z_nano( Kbb, Krhs ) 63 64 !!--------------------------------------------------------------------- 64 65 !! *** ROUTINE p5z_nano *** … … 68 69 !! ** Method : - ??? 69 70 !!--------------------------------------------------------------------- 71 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 70 72 INTEGER :: ji, jj, jk 71 73 REAL(wp) :: zcompaph … … 81 83 DO jj = 1, jpj 82 84 DO ji = 1, jpi 83 zcompaph = MAX( ( tr b(ji,jj,jk,jpphy) - 1e-9 ), 0.e0 )85 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 84 86 ! Squared mortality of Phyto similar to a sedimentation term during 85 87 ! blooms (Doney et al. 1996) 86 88 ! ----------------------------------------------------------------- 87 zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr b(ji,jj,jk,jpphy)89 zrespp = wchln * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jpphy,Kbb) 88 90 89 91 ! Phytoplankton linear mortality … … 94 96 ! Update the arrays TRA which contains the biological sources and sinks 95 97 96 zfactn = tr b(ji,jj,jk,jpnph)/(trb(ji,jj,jk,jpphy)+rtrn)97 zfactp = tr b(ji,jj,jk,jppph)/(trb(ji,jj,jk,jpphy)+rtrn)98 zfactfe = tr b(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn)99 zfactch = tr b(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn)100 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp101 tr a(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn102 tr a(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp103 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch104 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe98 zfactn = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 99 zfactp = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 100 zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 101 zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn) 102 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp 103 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn 104 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp 105 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch 106 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe 105 107 zprcaca = xfracal(ji,jj,jk) * zmortp 106 108 ! 107 109 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 108 110 ! 109 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca110 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca111 tr a(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca112 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp113 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn114 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp111 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca 112 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca 113 tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca 114 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 115 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 116 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 115 117 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 116 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe118 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 117 119 END DO 118 120 END DO … … 122 124 WRITE(charout, FMT="('nano')") 123 125 CALL prt_ctl_trc_info(charout) 124 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)126 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 125 127 ENDIF 126 128 ! … … 130 132 131 133 132 SUBROUTINE p5z_pico 134 SUBROUTINE p5z_pico( Kbb, Krhs ) 133 135 !!--------------------------------------------------------------------- 134 136 !! *** ROUTINE p5z_pico *** … … 138 140 !! ** Method : - ??? 139 141 !!--------------------------------------------------------------------- 142 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 140 143 INTEGER :: ji, jj, jk 141 144 REAL(wp) :: zcompaph … … 150 153 DO jj = 1, jpj 151 154 DO ji = 1, jpi 152 zcompaph = MAX( ( tr b(ji,jj,jk,jppic) - 1e-9 ), 0.e0 )155 zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 153 156 ! Squared mortality of Phyto similar to a sedimentation term during 154 157 ! blooms (Doney et al. 1996) 155 158 ! ----------------------------------------------------------------- 156 zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr b(ji,jj,jk,jppic)159 zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb) 157 160 158 161 ! Phytoplankton mortality … … 162 165 ! Update the arrays TRA which contains the biological sources and sinks 163 166 164 zfactn = tr b(ji,jj,jk,jpnpi)/(trb(ji,jj,jk,jppic)+rtrn)165 zfactp = tr b(ji,jj,jk,jpppi)/(trb(ji,jj,jk,jppic)+rtrn)166 zfactfe = tr b(ji,jj,jk,jppfe)/(trb(ji,jj,jk,jppic)+rtrn)167 zfactch = tr b(ji,jj,jk,jppch)/(trb(ji,jj,jk,jppic)+rtrn)168 tr a(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp169 tr a(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn170 tr a(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp171 tr a(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch172 tr a(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe173 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp174 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn175 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp176 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe167 zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 168 zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 169 zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 170 zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn) 171 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp 172 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn 173 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp 174 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch 175 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe 176 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp 177 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn 178 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp 179 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe 177 180 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 178 181 END DO … … 183 186 WRITE(charout, FMT="('pico')") 184 187 CALL prt_ctl_trc_info(charout) 185 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)188 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 186 189 ENDIF 187 190 ! … … 191 194 192 195 193 SUBROUTINE p5z_diat 196 SUBROUTINE p5z_diat( Kbb, Krhs ) 194 197 !!--------------------------------------------------------------------- 195 198 !! *** ROUTINE p5z_diat *** … … 199 202 !! ** Method : - ??? 200 203 !!--------------------------------------------------------------------- 204 INTEGER, INTENT(in) :: Kbb, Krhs ! time level indices 201 205 INTEGER :: ji, jj, jk 202 206 REAL(wp) :: zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi … … 213 217 DO ji = 1, jpi 214 218 215 zcompadi = MAX( ( tr b(ji,jj,jk,jpdia) - 1E-9), 0. )219 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) 216 220 217 221 ! Aggregation term for diatoms is increased in case of nutrient … … 223 227 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 224 228 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 225 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr b(ji,jj,jk,jpdia)229 zrespp2 = 1.e6 * xstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb) 226 230 227 231 ! Phytoplankton linear mortality … … 230 234 zmortp2 = zrespp2 + ztortp2 231 235 232 ! Update the arrays tr awhich contains the biological sources and sinks236 ! Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks 233 237 ! --------------------------------------------------------------------- 234 zfactn = tr b(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn )235 zfactp = tr b(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn )236 zfactch = tr b(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )237 zfactfe = tr b(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )238 zfactsi = tr b(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )239 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2240 tr a(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn241 tr a(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp242 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch243 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe244 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi245 tr a(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi246 tr a(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2247 tr a(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn248 tr a(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp249 tr a(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe250 tr a(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2251 tr a(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn252 tr a(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp253 tr a(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe238 zfactn = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 239 zfactp = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 240 zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 241 zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 242 zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 243 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 244 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn 245 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp 246 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch 247 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe 248 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi 249 tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi 250 tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 251 tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn 252 tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp 253 tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe 254 tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2 255 tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn 256 tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp 257 tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe 254 258 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortp2 255 259 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 … … 261 265 WRITE(charout, FMT="('diat')") 262 266 CALL prt_ctl_trc_info(charout) 263 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)267 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 264 268 ENDIF 265 269 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zprod.F90
r10425 r10975 57 57 CONTAINS 58 58 59 SUBROUTINE p5z_prod( kt , knt )59 SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs ) 60 60 !!--------------------------------------------------------------------- 61 61 !! *** ROUTINE p5z_prod *** … … 68 68 ! 69 69 INTEGER, INTENT(in) :: kt, knt 70 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 70 71 ! 71 72 INTEGER :: ji, jj, jk … … 136 137 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 137 138 zval = MAX( 1., zstrn(ji,jj) ) 138 IF( gdepw _n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN139 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 139 140 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 140 141 ENDIF … … 160 161 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 161 162 ! Computation of the P-I slope for nanos and diatoms 162 ztn = MAX( 0., ts n(ji,jj,jk,jp_tem) - 15. )163 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) 163 164 zadap = xadap * ztn / ( 2.+ ztn ) 164 165 ! 165 zpislopeadn(ji,jj,jk) = pislopen * tr b(ji,jj,jk,jpnch) &166 & /( tr b(ji,jj,jk,jpphy) * 12. + rtrn)166 zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb) & 167 & /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn) 167 168 zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) & 168 & * tr b(ji,jj,jk,jppch) /( trb(ji,jj,jk,jppic) * 12. + rtrn)169 zpislopeadd(ji,jj,jk) = pisloped * tr b(ji,jj,jk,jpdch) &170 & /( tr b(ji,jj,jk,jpdia) * 12. + rtrn)169 & * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn) 170 zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb) & 171 & /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn) 171 172 ! 172 173 zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) … … 203 204 ! Si/C is arbitrariliy increased for very high Si concentrations 204 205 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 205 zlim = tr b(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 )206 zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 ) 206 207 zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 207 208 zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 208 zsiborn = tr b(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil)209 zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) 209 210 IF (gphit(ji,jj) < -30 ) THEN 210 211 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) … … 236 237 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 237 238 ! production terms for nanophyto. 238 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr b(ji,jj,jk,jpphy) * rfact2239 zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2 239 240 ! 240 zration = tr b(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn )241 zratiop = tr b(ji,jj,jk,jppph) / ( trb(ji,jj,jk,jpphy) + rtrn )242 zratiof = tr b(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )243 zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr b(ji,jj,jk,jpphy) * rfact2241 zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 242 zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 243 zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn ) 244 zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2 244 245 ! Uptake of nitrogen 245 246 zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) … … 273 274 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 274 275 ! production terms for picophyto. 275 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr b(ji,jj,jk,jppic) * rfact2276 zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2 276 277 ! 277 zration = tr b(ji,jj,jk,jpnpi) / ( trb(ji,jj,jk,jppic) + rtrn )278 zratiop = tr b(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn )279 zratiof = tr b(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn )280 zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr b(ji,jj,jk,jppic) * rfact2278 zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 279 zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 280 zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn ) 281 zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2 281 282 ! Uptake of nitrogen 282 283 zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) … … 310 311 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 311 312 ! production terms for diatomees 312 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr b(ji,jj,jk,jpdia) * rfact2313 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2 313 314 ! Computation of the respiration term according to pahlow 314 315 ! & oschlies (2013) 315 316 ! 316 zration = tr b(ji,jj,jk,jpndi) / ( trb(ji,jj,jk,jpdia) + rtrn )317 zratiop = tr b(ji,jj,jk,jppdi) / ( trb(ji,jj,jk,jpdia) + rtrn )318 zratiof = tr b(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )319 zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr b(ji,jj,jk,jpdia) * rfact2317 zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 318 zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 319 zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn ) 320 zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2 320 321 ! Uptake of nitrogen 321 322 zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) … … 350 351 znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 351 352 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 352 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts n(ji,jj,jk,jp_tem))) &353 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 353 354 & * (1. - 1.14 / 43.4 * 20.)) 354 355 zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) … … 357 358 zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 358 359 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 359 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts n(ji,jj,jk,jp_tem))) &360 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 360 361 & * (1. - 1.14 / 43.4 * 20.)) 361 362 zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) … … 364 365 zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 365 366 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 366 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts n(ji,jj,jk,jp_tem))) &367 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) & 367 368 & * (1. - 1.14 / 43.4 * 20.)) 368 369 zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 369 370 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 370 371 ! Update the arrays TRA which contain the Chla sources and sinks 371 tr a(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn372 tr a(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd373 tr a(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) + zprochlp * texcretp372 tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn 373 tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd 374 tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp 374 375 ENDIF 375 376 END DO … … 386 387 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 387 388 & + excretp * zprorcap(ji,jj,jk) 388 tr a(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) &389 tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) & 389 390 & - zpropo4p(ji,jj,jk) 390 tr a(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) &391 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) & 391 392 & - zpronewp(ji,jj,jk) 392 tr a(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) &393 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) & 393 394 & - zproregp(ji,jj,jk) 394 tr a(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn &395 tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn & 395 396 & - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) & 396 397 & - zrespn(ji,jj,jk) 397 zcroissn(ji,jj,jk) = tr a(ji,jj,jk,jpphy) / rfact2/ (trb(ji,jj,jk,jpphy) + rtrn)398 tr a(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) + zprontot * texcretn399 tr a(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) + zpropo4n(ji,jj,jk) * texcretn &398 zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn) 399 tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn 400 tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn & 400 401 & + zprodopn(ji,jj,jk) * texcretn 401 tr a(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn402 tr a(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) + zprorcap(ji,jj,jk) * texcretp &402 tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn 403 tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp & 403 404 & - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) & 404 405 & - zrespp(ji,jj,jk) 405 zcroissp(ji,jj,jk) = tr a(ji,jj,jk,jppic) / rfact2/ (trb(ji,jj,jk,jppic) + rtrn)406 tr a(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) + zproptot * texcretp407 tr a(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) + zpropo4p(ji,jj,jk) * texcretp &406 zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn) 407 tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp 408 tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp & 408 409 & + zprodopp(ji,jj,jk) * texcretp 409 tr a(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) + zprofep(ji,jj,jk) * texcretp410 tr a(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd &410 tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp 411 tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd & 411 412 & - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) & 412 413 & - zrespd(ji,jj,jk) 413 zcroissd(ji,jj,jk) = tr a(ji,jj,jk,jpdia) / rfact2 / (trb(ji,jj,jk,jpdia) + rtrn)414 tr a(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) + zprodtot * texcretd415 tr a(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) + zpropo4d(ji,jj,jk) * texcretd &414 zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn) 415 tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd 416 tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd & 416 417 & + zprodopd(ji,jj,jk) * texcretd 417 tr a(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd418 tr a(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd419 tr a(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) &418 tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd 419 tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 420 tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) & 420 421 & + excretp * zprorcap(ji,jj,jk) 421 tr a(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + excretd * zprodtot + excretn * zprontot &422 tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot & 422 423 & + excretp * zproptot 423 tr a(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) &424 tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) & 424 425 & - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) & 425 426 & - texcretp * zprodopp(ji,jj,jk) 426 tr a(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) &427 tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 427 428 & + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) & 428 429 & + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) & 429 430 & - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) ) 430 431 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 431 tr a(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup432 tr a(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)433 tr a(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) &432 tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup 433 tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 434 tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) & 434 435 & + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) & 435 436 & + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk) & 436 437 & + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk) & 437 438 & + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 438 tr a(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) &439 tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) & 439 440 & + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) & 440 441 & + zproregp(ji,jj,jk) ) … … 449 450 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 450 451 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 451 tr a(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet452 tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 452 453 zpligprod1(ji,jj,jk) = zdocprod * ldocp 453 454 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet … … 556 557 WRITE(charout, FMT="('prod')") 557 558 CALL prt_ctl_trc_info(charout) 558 CALL prt_ctl_trc(tab4d=tr a, mask=tmask, clinfo=ctrcnm)559 CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 559 560 ENDIF 560 561 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/oce_sed.F90
r10362 r10975 13 13 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 14 14 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 15 USE dom_oce , ONLY : e3t _n => e3t_n!: latitude of t-point (degre)15 USE dom_oce , ONLY : e3t => e3t !: latitude of t-point (degre) 16 16 USE dom_oce , ONLY : e3t_1d => e3t_1d !: reference depth of t-points (m) 17 17 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of t-points (m) … … 26 26 ! !: that may have been run with different time steps. 27 27 28 USE oce , ONLY : tsn => tsn!: pot. temperature (celsius) and salinity (psu)29 USE trc , ONLY : trb => trb!: pot. temperature (celsius) and salinity (psu)28 USE oce , ONLY : ts => ts !: pot. temperature (celsius) and salinity (psu) 29 USE trc , ONLY : tr => tr !: pot. temperature (celsius) and salinity (psu) 30 30 31 31 USE sms_pisces, ONLY : wsbio4 => wsbio4 !: sinking flux for POC 32 32 USE sms_pisces, ONLY : wsbio3 => wsbio3 !: sinking flux for GOC 33 USE sms_pisces, ONLY : wsbio2 => wsbio2 33 USE sms_pisces, ONLY : wsbio2 => wsbio2 !: sinking flux for calcite 34 34 USE sms_pisces, ONLY : wsbio => wsbio !: sinking flux for calcite 35 35 USE sms_pisces, ONLY : ln_p5z => ln_p5z !: PISCES-QUOTA flag -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/seddta.F90
r10362 r10975 29 29 !!--------------------------------------------------------------------------- 30 30 31 SUBROUTINE sed_dta( kt )31 SUBROUTINE sed_dta( kt, Kbb, Kmm ) 32 32 !!---------------------------------------------------------------------- 33 33 !! *** ROUTINE sed_dta *** … … 43 43 44 44 !! Arguments 45 INTEGER, INTENT(in) :: kt ! time-step 45 INTEGER, INTENT(in) :: kt ! time-step 46 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 46 47 47 48 !! * Local declarations … … 103 104 DO ji = 1, jpi 104 105 ikt = mbkt(ji,jj) 105 zdep = e3t _n(ji,jj,ikt) / r2dttrc106 zdep = e3t(ji,jj,ikt,Kmm) / r2dttrc 106 107 zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) / rday ) 107 108 zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) / rday ) … … 115 116 ikt = mbkt(ji,jj) 116 117 IF ( tmask(ji,jj,ikt) == 1 ) THEN 117 trc_data(ji,jj,1) = tr b(ji,jj,ikt,jpsil)118 trc_data(ji,jj,2) = tr b(ji,jj,ikt,jpoxy)119 trc_data(ji,jj,3) = tr b(ji,jj,ikt,jpdic)120 trc_data(ji,jj,4) = tr b(ji,jj,ikt,jpno3) / 7.625121 trc_data(ji,jj,5) = tr b(ji,jj,ikt,jppo4) / 122.122 trc_data(ji,jj,6) = tr b(ji,jj,ikt,jptal)123 trc_data(ji,jj,7) = tr b(ji,jj,ikt,jpnh4) / 7.625118 trc_data(ji,jj,1) = tr(ji,jj,ikt,jpsil,Kbb) 119 trc_data(ji,jj,2) = tr(ji,jj,ikt,jpoxy,Kbb) 120 trc_data(ji,jj,3) = tr(ji,jj,ikt,jpdic,Kbb) 121 trc_data(ji,jj,4) = tr(ji,jj,ikt,jpno3,Kbb) / 7.625 122 trc_data(ji,jj,5) = tr(ji,jj,ikt,jppo4,Kbb) / 122. 123 trc_data(ji,jj,6) = tr(ji,jj,ikt,jptal,Kbb) 124 trc_data(ji,jj,7) = tr(ji,jj,ikt,jpnh4,Kbb) / 7.625 124 125 trc_data(ji,jj,8) = 0.0 125 126 trc_data(ji,jj,9) = 28.0E-3 126 trc_data(ji,jj,10) = tr b(ji,jj,ikt,jpfer)127 trc_data(ji,jj,11 ) = MIN(tr b(ji,jj,ikt,jpgsi), 1E-4) * zwsbio4(ji,jj) * 1E3128 trc_data(ji,jj,12 ) = MIN(tr b(ji,jj,ikt,jppoc), 1E-4) * zwsbio3(ji,jj) * 1E3129 trc_data(ji,jj,13 ) = MIN(tr b(ji,jj,ikt,jpgoc), 1E-4) * zwsbio4(ji,jj) * 1E3130 trc_data(ji,jj,14) = MIN(tr b(ji,jj,ikt,jpcal), 1E-4) * zwsbio4(ji,jj) * 1E3131 trc_data(ji,jj,15) = ts n(ji,jj,ikt,jp_tem)132 trc_data(ji,jj,16) = ts n(ji,jj,ikt,jp_sal)133 trc_data(ji,jj,17 ) = ( tr b(ji,jj,ikt,jpsfe) * zwsbio3(ji,jj) + trb(ji,jj,ikt,jpbfe) &127 trc_data(ji,jj,10) = tr(ji,jj,ikt,jpfer,Kbb) 128 trc_data(ji,jj,11 ) = MIN(tr(ji,jj,ikt,jpgsi,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 129 trc_data(ji,jj,12 ) = MIN(tr(ji,jj,ikt,jppoc,Kbb), 1E-4) * zwsbio3(ji,jj) * 1E3 130 trc_data(ji,jj,13 ) = MIN(tr(ji,jj,ikt,jpgoc,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 131 trc_data(ji,jj,14) = MIN(tr(ji,jj,ikt,jpcal,Kbb), 1E-4) * zwsbio4(ji,jj) * 1E3 132 trc_data(ji,jj,15) = ts(ji,jj,ikt,jp_tem,Kmm) 133 trc_data(ji,jj,16) = ts(ji,jj,ikt,jp_sal,Kmm) 134 trc_data(ji,jj,17 ) = ( tr(ji,jj,ikt,jpsfe,Kbb) * zwsbio3(ji,jj) + tr(ji,jj,ikt,jpbfe,Kbb) & 134 135 & * zwsbio4(ji,jj) ) * 1E3 / ( trc_data(ji,jj,12 ) + trc_data(ji,jj,13 ) + rtrn ) 135 136 trc_data(ji,jj,17 ) = MIN(1E-3, trc_data(ji,jj,17 ) ) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedinitrc.F90
r10225 r10975 33 33 34 34 35 SUBROUTINE sed_initrc 35 SUBROUTINE sed_initrc( Kbb, Kmm ) 36 36 !!---------------------------------------------------------------------- 37 37 !! *** ROUTINE sed_init *** … … 50 50 !! ! 06-07 (C. Ethe) Re-organization 51 51 !!---------------------------------------------------------------------- 52 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 52 53 INTEGER :: ji, jj, ikt 53 54 !!---------------------------------------------------------------------- … … 65 66 ! ( only clay or reading restart file ) 66 67 !--------------------------------------- 67 CALL sed_init_data 68 CALL sed_init_data( Kbb, Kmm ) 68 69 69 70 … … 74 75 75 76 76 SUBROUTINE sed_init_data 77 SUBROUTINE sed_init_data( Kbb, Kmm ) 77 78 !!---------------------------------------------------------------------- 78 79 !! *** ROUTINE sed_init_data *** … … 85 86 !! ! 06-07 (C. Ethe) original 86 87 !!---------------------------------------------------------------------- 88 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 87 89 88 90 ! local variables … … 128 130 129 131 ! Load initial Pisces Data for bot. wat. Chem and fluxes 130 CALL sed_dta ( nitsed000 )132 CALL sed_dta ( nitsed000, Kbb, Kmm ) 131 133 132 134 ! Initialization of chemical constants -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedmodel.F90
r10963 r10975 16 16 CONTAINS 17 17 18 SUBROUTINE sed_model ( kt, K mm)18 SUBROUTINE sed_model ( kt, Kbb, Kmm, Krhs ) 19 19 !!--------------------------------------------------------------------- 20 20 !! *** ROUTINE sed_model *** … … 29 29 !! ! 07-02 (C. Ethe) Original 30 30 !!---------------------------------------------------------------------- 31 INTEGER, INTENT(in) :: kt ! number of iteration32 INTEGER, INTENT(in) :: K mm! time level indices31 INTEGER, INTENT(in) :: kt ! number of iteration 32 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 33 33 34 34 35 35 IF( ln_timing ) CALL timing_start('sed_model') 36 36 37 IF( kt == nittrc000 ) CALL sed_initrc ! Initialization of sediment model38 CALL sed_stp( kt, K mm) ! Time stepping of Sediment model37 IF( kt == nittrc000 ) CALL sed_initrc( Kbb, Kmm ) ! Initialization of sediment model 38 CALL sed_stp( kt, Kbb, Kmm, Krhs ) ! Time stepping of Sediment model 39 39 40 40 IF( ln_timing ) CALL timing_stop('sed_model') -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedsfc.F90
r10222 r10975 14 14 CONTAINS 15 15 16 SUBROUTINE sed_sfc( kt )16 SUBROUTINE sed_sfc( kt, Kbb ) 17 17 !!--------------------------------------------------------------------- 18 18 !! *** ROUTINE sed_sfc *** … … 26 26 !!* Arguments 27 27 INTEGER, INTENT(in) :: kt ! time step 28 INTEGER, INTENT(in) :: Kbb ! time index 28 29 29 30 ! * local variables … … 49 50 ikt = mbkt(ji,jj) 50 51 IF ( tmask(ji,jj,ikt) == 1 ) THEN 51 tr b(ji,jj,ikt,jptal) = trc_data(ji,jj,1)52 tr b(ji,jj,ikt,jpdic) = trc_data(ji,jj,2)53 tr b(ji,jj,ikt,jpno3) = trc_data(ji,jj,3) * 7.62554 tr b(ji,jj,ikt,jppo4) = trc_data(ji,jj,4) * 122.55 tr b(ji,jj,ikt,jpoxy) = trc_data(ji,jj,5)56 tr b(ji,jj,ikt,jpsil) = trc_data(ji,jj,6)57 tr b(ji,jj,ikt,jpnh4) = trc_data(ji,jj,7) * 7.62558 tr b(ji,jj,ikt,jpfer) = trc_data(ji,jj,8)52 tr(ji,jj,ikt,jptal,Kbb) = trc_data(ji,jj,1) 53 tr(ji,jj,ikt,jpdic,Kbb) = trc_data(ji,jj,2) 54 tr(ji,jj,ikt,jpno3,Kbb) = trc_data(ji,jj,3) * 7.625 55 tr(ji,jj,ikt,jppo4,Kbb) = trc_data(ji,jj,4) * 122. 56 tr(ji,jj,ikt,jpoxy,Kbb) = trc_data(ji,jj,5) 57 tr(ji,jj,ikt,jpsil,Kbb) = trc_data(ji,jj,6) 58 tr(ji,jj,ikt,jpnh4,Kbb) = trc_data(ji,jj,7) * 7.625 59 tr(ji,jj,ikt,jpfer,Kbb) = trc_data(ji,jj,8) 59 60 ENDIF 60 61 ENDDO -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/sedstp.F90
r10963 r10975 29 29 CONTAINS 30 30 31 SUBROUTINE sed_stp ( kt, K mm)31 SUBROUTINE sed_stp ( kt, Kbb, Kmm, Krhs ) 32 32 !!--------------------------------------------------------------------- 33 33 !! *** ROUTINE sed_stp *** … … 44 44 !! ! 06-04 (C. Ethe) Re-organization 45 45 !!---------------------------------------------------------------------- 46 INTEGER, INTENT(in) :: kt ! number of iteration47 INTEGER, INTENT(in) :: K mm! time level indices46 INTEGER, INTENT(in) :: kt ! number of iteration 47 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 48 48 INTEGER :: ji,jk,js,jn,jw 49 49 !!---------------------------------------------------------------------- … … 53 53 IF( lrst_sed ) CALL sed_rst_cal ( kt, 'WRITE' ) ! calenda 54 54 55 IF(ln_sediment_offline) CALL trc_dmp_sed ( kt, K mm)55 IF(ln_sediment_offline) CALL trc_dmp_sed ( kt, Kbb, Kmm, Krhs ) 56 56 57 57 dtsed = r2dttrc 58 58 ! dtsed2 = dtsed 59 59 IF (kt /= nitsed000) THEN 60 CALL sed_dta( kt ) ! Load Data for bot. wat. Chem and fluxes60 CALL sed_dta( kt, Kbb, Kmm ) ! Load Data for bot. wat. Chem and fluxes 61 61 ENDIF 62 62 … … 81 81 CALL sed_mbc( kt ) ! cumulation for mass balance calculation 82 82 83 IF (ln_sed_2way) CALL sed_sfc( kt ) ! Give back new bottom wat chem to tracer model83 IF (ln_sed_2way) CALL sed_sfc( kt, Kbb ) ! Give back new bottom wat chem to tracer model 84 84 ENDIF 85 85 CALL sed_wri( kt ) ! outputs -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/SED/trcdmp_sed.F90
r10963 r10975 54 54 55 55 56 SUBROUTINE trc_dmp_sed( kt, K mm)56 SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) 57 57 !!---------------------------------------------------------------------- 58 58 !! *** ROUTINE trc_dmp_sed *** … … 64 64 !! ** Method : Newtonian damping towards trdta computed 65 65 !! and add to the general tracer trends: 66 !! tr n = tra + restotr * (trdta - trb)66 !! tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 67 67 !! The trend is computed either throughout the water column 68 68 !! (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 69 69 !! below the well mixed layer (nlmdmptr=2) 70 70 !! 71 !! ** Action : - update the tracer trends tr awith the newtonian71 !! ** Action : - update the tracer trends tr(Krhs) with the newtonian 72 72 !! damping trends. 73 73 !! - save the trends ('key_trdmxl_trc') 74 74 !!---------------------------------------------------------------------- 75 INTEGER, INTENT(in) :: kt ! ocean time-step index76 INTEGER, INTENT(in) :: K mm! time level index75 INTEGER, INTENT(in) :: kt ! ocean time-step index 76 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level index 77 77 ! 78 78 INTEGER :: ji, jj, jk, jn, jl, ikt ! dummy loop indices … … 96 96 DO ji = 1, jpi ! vector opt. 97 97 ikt = mbkt(ji,jj) 98 tr b(ji,jj,ikt,jn) = ztrcdta(ji,jj,ikt) + ( trb(ji,jj,ikt,jn) - ztrcdta(ji,jj,ikt) ) &98 tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) & 99 99 & * exp( -restosed(ji,jj,ikt) * dtsed ) 100 100 END DO … … 110 110 WRITE(charout, FMT="('dmp ')") 111 111 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc( tab4d=tr a, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )112 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 113 113 ENDIF 114 114 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/trcini_pisces.F90
r10425 r10975 32 32 CONTAINS 33 33 34 SUBROUTINE trc_ini_pisces 34 SUBROUTINE trc_ini_pisces( Kmm ) 35 35 !!---------------------------------------------------------------------- 36 36 !! *** ROUTINE trc_ini_pisces *** … … 38 38 !! ** Purpose : Initialisation of the PISCES biochemical model 39 39 !!---------------------------------------------------------------------- 40 INTEGER, INTENT(in) :: Kmm ! time level indices 40 41 ! 41 42 CALL trc_nam_pisces 42 43 ! 43 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_ini ! PISCES44 ELSE ; CALL p2z_ini ! LOBSTER44 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_ini( Kmm ) ! PISCES 45 ELSE ; CALL p2z_ini( Kmm ) ! LOBSTER 45 46 ENDIF 46 47 … … 48 49 49 50 50 SUBROUTINE p4z_ini 51 SUBROUTINE p4z_ini( Kmm ) 51 52 !!---------------------------------------------------------------------- 52 53 !! *** ROUTINE p4z_ini *** … … 77 78 USE p5zmort ! Mortality terms for phytoplankton 78 79 ! 80 INTEGER, INTENT(in) :: Kmm ! time level indices 79 81 REAL(wp), SAVE :: sco2 = 2.312e-3_wp 80 82 REAL(wp), SAVE :: alka0 = 2.426e-3_wp … … 189 191 !-------------------------------------------------------------- 190 192 IF( .NOT.ln_rsttr ) THEN 191 tr n(:,:,:,jpdic) = sco2192 tr n(:,:,:,jpdoc) = bioma0193 tr n(:,:,:,jptal) = alka0194 tr n(:,:,:,jpoxy) = oxyg0195 tr n(:,:,:,jpcal) = bioma0196 tr n(:,:,:,jppo4) = po4 / po4r197 tr n(:,:,:,jppoc) = bioma0198 tr n(:,:,:,jpgoc) = bioma0199 tr n(:,:,:,jpbfe) = bioma0 * 5.e-6200 tr n(:,:,:,jpsil) = silic1201 tr n(:,:,:,jpdsi) = bioma0 * 0.15202 tr n(:,:,:,jpgsi) = bioma0 * 5.e-6203 tr n(:,:,:,jpphy) = bioma0204 tr n(:,:,:,jpdia) = bioma0205 tr n(:,:,:,jpzoo) = bioma0206 tr n(:,:,:,jpmes) = bioma0207 tr n(:,:,:,jpfer) = 0.6E-9208 tr n(:,:,:,jpsfe) = bioma0 * 5.e-6209 tr n(:,:,:,jpdfe) = bioma0 * 5.e-6210 tr n(:,:,:,jpnfe) = bioma0 * 5.e-6211 tr n(:,:,:,jpnch) = bioma0 * 12. / 55.212 tr n(:,:,:,jpdch) = bioma0 * 12. / 55.213 tr n(:,:,:,jpno3) = no3214 tr n(:,:,:,jpnh4) = bioma0193 tr(:,:,:,jpdic,Kmm) = sco2 194 tr(:,:,:,jpdoc,Kmm) = bioma0 195 tr(:,:,:,jptal,Kmm) = alka0 196 tr(:,:,:,jpoxy,Kmm) = oxyg0 197 tr(:,:,:,jpcal,Kmm) = bioma0 198 tr(:,:,:,jppo4,Kmm) = po4 / po4r 199 tr(:,:,:,jppoc,Kmm) = bioma0 200 tr(:,:,:,jpgoc,Kmm) = bioma0 201 tr(:,:,:,jpbfe,Kmm) = bioma0 * 5.e-6 202 tr(:,:,:,jpsil,Kmm) = silic1 203 tr(:,:,:,jpdsi,Kmm) = bioma0 * 0.15 204 tr(:,:,:,jpgsi,Kmm) = bioma0 * 5.e-6 205 tr(:,:,:,jpphy,Kmm) = bioma0 206 tr(:,:,:,jpdia,Kmm) = bioma0 207 tr(:,:,:,jpzoo,Kmm) = bioma0 208 tr(:,:,:,jpmes,Kmm) = bioma0 209 tr(:,:,:,jpfer,Kmm) = 0.6E-9 210 tr(:,:,:,jpsfe,Kmm) = bioma0 * 5.e-6 211 tr(:,:,:,jpdfe,Kmm) = bioma0 * 5.e-6 212 tr(:,:,:,jpnfe,Kmm) = bioma0 * 5.e-6 213 tr(:,:,:,jpnch,Kmm) = bioma0 * 12. / 55. 214 tr(:,:,:,jpdch,Kmm) = bioma0 * 12. / 55. 215 tr(:,:,:,jpno3,Kmm) = no3 216 tr(:,:,:,jpnh4,Kmm) = bioma0 215 217 IF( ln_ligand) THEN 216 tr n(:,:,:,jplgw) = 0.6E-9218 tr(:,:,:,jplgw,Kmm) = 0.6E-9 217 219 ENDIF 218 220 IF( ln_p5z ) THEN 219 tr n(:,:,:,jpdon) = bioma0220 tr n(:,:,:,jpdop) = bioma0221 tr n(:,:,:,jppon) = bioma0222 tr n(:,:,:,jppop) = bioma0223 tr n(:,:,:,jpgon) = bioma0224 tr n(:,:,:,jpgop) = bioma0225 tr n(:,:,:,jpnph) = bioma0226 tr n(:,:,:,jppph) = bioma0227 tr n(:,:,:,jppic) = bioma0228 tr n(:,:,:,jpnpi) = bioma0229 tr n(:,:,:,jpppi) = bioma0230 tr n(:,:,:,jpndi) = bioma0231 tr n(:,:,:,jppdi) = bioma0232 tr n(:,:,:,jppfe) = bioma0 * 5.e-6233 tr n(:,:,:,jppch) = bioma0 * 12. / 55.221 tr(:,:,:,jpdon,Kmm) = bioma0 222 tr(:,:,:,jpdop,Kmm) = bioma0 223 tr(:,:,:,jppon,Kmm) = bioma0 224 tr(:,:,:,jppop,Kmm) = bioma0 225 tr(:,:,:,jpgon,Kmm) = bioma0 226 tr(:,:,:,jpgop,Kmm) = bioma0 227 tr(:,:,:,jpnph,Kmm) = bioma0 228 tr(:,:,:,jppph,Kmm) = bioma0 229 tr(:,:,:,jppic,Kmm) = bioma0 230 tr(:,:,:,jpnpi,Kmm) = bioma0 231 tr(:,:,:,jpppi,Kmm) = bioma0 232 tr(:,:,:,jpndi,Kmm) = bioma0 233 tr(:,:,:,jppdi,Kmm) = bioma0 234 tr(:,:,:,jppfe,Kmm) = bioma0 * 5.e-6 235 tr(:,:,:,jppch,Kmm) = bioma0 * 12. / 55. 234 236 ENDIF 235 237 ! initialize the half saturation constant for silicate … … 254 256 CALL p5z_prod_init ! phytoplankton growth rate over the global ocean. 255 257 ENDIF 256 CALL p4z_sbc_init 258 CALL p4z_sbc_init( Kmm ) ! boundary conditions 257 259 CALL p4z_fechem_init ! Iron chemistry 258 260 CALL p4z_rem_init ! remineralisation … … 288 290 289 291 290 SUBROUTINE p2z_ini 292 SUBROUTINE p2z_ini( Kmm ) 291 293 !!---------------------------------------------------------------------- 292 294 !! *** ROUTINE p2z_ini *** … … 300 302 USE p2zsed 301 303 ! 304 INTEGER, INTENT(in) :: Kmm ! time level indices 302 305 INTEGER :: ji, jj, jk, jn, ierr 303 306 CHARACTER(len = 10) :: cltra … … 338 341 ! ---------------------- 339 342 IF( .NOT. ln_rsttr ) THEN ! in case of no restart 340 tr n(:,:,:,jpdet) = 0.1 * tmask(:,:,:)341 tr n(:,:,:,jpzoo) = 0.1 * tmask(:,:,:)342 tr n(:,:,:,jpnh4) = 0.1 * tmask(:,:,:)343 tr n(:,:,:,jpphy) = 0.1 * tmask(:,:,:)344 tr n(:,:,:,jpdom) = 1.0 * tmask(:,:,:)345 WHERE( rhd(:,:,:) <= 24.5e-3 ) ; tr n(:,:,:,jpno3) = 2._wp * tmask(:,:,:)346 ELSE WHERE ; tr n(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:)343 tr(:,:,:,jpdet,Kmm) = 0.1 * tmask(:,:,:) 344 tr(:,:,:,jpzoo,Kmm) = 0.1 * tmask(:,:,:) 345 tr(:,:,:,jpnh4,Kmm) = 0.1 * tmask(:,:,:) 346 tr(:,:,:,jpphy,Kmm) = 0.1 * tmask(:,:,:) 347 tr(:,:,:,jpdom,Kmm) = 1.0 * tmask(:,:,:) 348 WHERE( rhd(:,:,:) <= 24.5e-3 ) ; tr(:,:,:,jpno3,Kmm) = 2._wp * tmask(:,:,:) 349 ELSE WHERE ; tr(:,:,:,jpno3,Kmm) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 347 350 END WHERE 348 351 ENDIF 349 ! ! Namelist read350 CALL p2z_opt_init ! Optics parameters351 CALL p2z_sed_init ! sedimentation352 CALL p2z_bio_init ! biology353 CALL p2z_exp_init 352 ! ! Namelist read 353 CALL p2z_opt_init ! Optics parameters 354 CALL p2z_sed_init ! sedimentation 355 CALL p2z_bio_init ! biology 356 CALL p2z_exp_init( Kmm ) ! export 354 357 ! 355 358 IF(lwp) WRITE(numout,*) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/trcsms_pisces.F90
r10966 r10975 25 25 CONTAINS 26 26 27 SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm )27 SUBROUTINE trc_sms_pisces( kt, Kbb, Kmm, Krhs ) 28 28 !!--------------------------------------------------------------------- 29 29 !! *** ROUTINE trc_sms_pisces *** … … 34 34 !!--------------------------------------------------------------------- 35 35 ! 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index37 INTEGER, INTENT( in ) :: Kbb, Kmm 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index 37 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 38 38 !!--------------------------------------------------------------------- 39 39 ! 40 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_sms( kt, Kbb, Kmm ) ! PISCES41 ELSE ; CALL p2z_sms( kt, Kmm ) ! LOBSTER40 IF( ln_p4z .OR. ln_p5z ) THEN ; CALL p4z_sms( kt, Kbb, Kmm, Krhs ) ! PISCES 41 ELSE ; CALL p2z_sms( kt, Kmm, Krhs ) ! LOBSTER 42 42 ENDIF 43 43 -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/trcwri_pisces.F90
r10069 r10975 26 26 CONTAINS 27 27 28 SUBROUTINE trc_wri_pisces 28 SUBROUTINE trc_wri_pisces( Kmm ) 29 29 !!--------------------------------------------------------------------- 30 30 !! *** ROUTINE trc_wri_trc *** … … 32 32 !! ** Purpose : output passive tracers fields 33 33 !!--------------------------------------------------------------------- 34 INTEGER, INTENT(in) :: Kmm ! time level indices 34 35 CHARACTER (len=20) :: cltra 35 36 REAL(wp) :: zfact … … 43 44 DO jn = jp_pcs0, jp_pcs1 44 45 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 45 CALL iom_put( cltra, tr n(:,:,:,jn) )46 CALL iom_put( cltra, tr(:,:,:,jn,Kmm) ) 46 47 END DO 47 48 ELSE … … 51 52 IF( jn == jppo4 ) zfact = po4r * 1.0e+6 52 53 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 53 IF( iom_use( cltra ) ) CALL iom_put( cltra, tr n(:,:,:,jn) * zfact )54 IF( iom_use( cltra ) ) CALL iom_put( cltra, tr(:,:,:,jn,Kmm) * zfact ) 54 55 END DO 55 56 … … 57 58 zdic(:,:) = 0. 58 59 DO jk = 1, jpkm1 59 zdic(:,:) = zdic(:,:) + tr n(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.60 zdic(:,:) = zdic(:,:) + tr(:,:,jk,jpdic,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * 12. 60 61 ENDDO 61 62 CALL iom_put( 'INTDIC', zdic ) … … 63 64 ! 64 65 IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN ! Oxygen minimum concentration and depth 65 zo2min (:,:) = tr n(:,:,1,jpoxy) * tmask(:,:,1)66 zdepo2min(:,:) = gdepw _n(:,:,1) * tmask(:,:,1)66 zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 67 zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1) 67 68 DO jk = 2, jpkm1 68 69 DO jj = 1, jpj 69 70 DO ji = 1, jpi 70 71 IF( tmask(ji,jj,jk) == 1 ) then 71 IF( tr n(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then72 zo2min (ji,jj) = tr n(ji,jj,jk,jpoxy)73 zdepo2min(ji,jj) = gdepw _n(ji,jj,jk)72 IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then 73 zo2min (ji,jj) = tr(ji,jj,jk,jpoxy,Kmm) 74 zdepo2min(ji,jj) = gdepw(ji,jj,jk,Kmm) 74 75 ENDIF 75 76 ENDIF -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcini.F90
r10963 r10975 75 75 IF(lwp) WRITE(numout,*) 76 76 ! 77 CALL trc_ini_sms ! SMS78 CALL trc_ini_trp ! passive tracers transport79 CALL trc_ice_ini ! Tracers in sea ice77 CALL trc_ini_sms( Kmm ) ! SMS 78 CALL trc_ini_trp ! passive tracers transport 79 CALL trc_ice_ini ! Tracers in sea ice 80 80 ! 81 81 IF( lwm .AND. sn_cfctl%l_trcstat ) THEN … … 159 159 160 160 161 SUBROUTINE trc_ini_sms 161 SUBROUTINE trc_ini_sms( Kmm ) 162 162 !!---------------------------------------------------------------------- 163 163 !! *** ROUTINE trc_ini_sms *** … … 170 170 USE trcini_my_trc ! MY_TRC initialisation 171 171 ! 172 INTEGER, INTENT(in) :: Kmm ! time level indices 172 173 INTEGER :: jn 173 174 !!---------------------------------------------------------------------- … … 184 185 END DO 185 186 ! 186 IF( ln_pisces ) CALL trc_ini_pisces ! PISCES model187 IF( ln_my_trc ) CALL trc_ini_my_trc ! MY_TRC model188 IF( ll_cfc ) CALL trc_ini_cfc ! CFC's189 IF( ln_c14 ) CALL trc_ini_c14 ! C14 model190 IF( ln_age ) CALL trc_ini_age ! AGE187 IF( ln_pisces ) CALL trc_ini_pisces( Kmm ) ! PISCES model 188 IF( ln_my_trc ) CALL trc_ini_my_trc( Kmm ) ! MY_TRC model 189 IF( ll_cfc ) CALL trc_ini_cfc ( Kmm ) ! CFC's 190 IF( ln_c14 ) CALL trc_ini_c14 ( Kmm ) ! C14 model 191 IF( ln_age ) CALL trc_ini_age ( Kmm ) ! AGE 191 192 IF( .NOT.ln_pisces ) ALLOCATE( profsed(2) ) 192 193 ! -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcsms.F90
r10966 r10975 50 50 IF( ln_timing ) CALL timing_start('trc_sms') 51 51 ! 52 IF( ln_pisces ) CALL trc_sms_pisces ( kt, Kbb, Kmm )! main program of PISCES53 IF( ll_cfc ) CALL trc_sms_cfc ( kt, Kmm )! surface fluxes of CFC54 IF( ln_c14 ) CALL trc_sms_c14 ( kt, Kmm )! surface fluxes of C1455 IF( ln_age ) CALL trc_sms_age ( kt, Kmm )! Age tracer56 IF( ln_my_trc ) CALL trc_sms_my_trc ( kt, 52 IF( ln_pisces ) CALL trc_sms_pisces ( kt, Kbb, Kmm, Krhs ) ! main program of PISCES 53 IF( ll_cfc ) CALL trc_sms_cfc ( kt, Kbb, Kmm, Krhs ) ! surface fluxes of CFC 54 IF( ln_c14 ) CALL trc_sms_c14 ( kt, Kbb, Kmm, Krhs ) ! surface fluxes of C14 55 IF( ln_age ) CALL trc_sms_age ( kt, Kbb, Kmm, Krhs ) ! Age tracer 56 IF( ln_my_trc ) CALL trc_sms_my_trc ( kt, Kbb, Kmm, Krhs ) ! MY_TRC tracers 57 57 58 58 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcstp.F90
r10966 r10975 100 100 CALL trc_rst_opn ( kt ) ! Open tracer restart file 101 101 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar 102 CALL trc_wri ( kt )! output of passive tracers with iom I/O manager102 CALL trc_wri ( kt, Kmm ) ! output of passive tracers with iom I/O manager 103 103 CALL trc_sms ( kt, Kbb, Kmm, Krhs ) ! tracers: sinks and sources 104 104 CALL trc_trp ( kt, Kbb, Kmm, Krhs, Kaa ) ! transport of passive tracers -
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/trcwri.F90
r10068 r10975 30 30 CONTAINS 31 31 32 SUBROUTINE trc_wri( kt )32 SUBROUTINE trc_wri( kt, Kmm ) 33 33 !!--------------------------------------------------------------------- 34 34 !! *** ROUTINE trc_wri *** … … 37 37 !!--------------------------------------------------------------------- 38 38 INTEGER, INTENT( in ) :: kt 39 INTEGER, INTENT( in ) :: Kmm ! time level indices 39 40 ! 40 41 INTEGER :: jn … … 54 55 ! write the tracer concentrations in the file 55 56 ! --------------------------------------- 56 IF( ln_pisces ) CALL trc_wri_pisces ! PISCES57 IF( ll_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC58 IF( ln_c14 ) CALL trc_wri_c14 ! surface fluxes of C1459 IF( ln_age ) CALL trc_wri_age ! AGE tracer60 IF( ln_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers57 IF( ln_pisces ) CALL trc_wri_pisces( Kmm ) ! PISCES 58 IF( ll_cfc ) CALL trc_wri_cfc ( Kmm ) ! surface fluxes of CFC 59 IF( ln_c14 ) CALL trc_wri_c14 ( Kmm ) ! surface fluxes of C14 60 IF( ln_age ) CALL trc_wri_age ( Kmm ) ! AGE tracer 61 IF( ln_my_trc ) CALL trc_wri_my_trc( Kmm ) ! MY_TRC tracers 61 62 ! 62 63 IF( ln_timing ) CALL timing_stop('trc_wri')
Note: See TracChangeset
for help on using the changeset viewer.