- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
TOP/PISCES/P4Z/p5zmort.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p5zmort.F90
r11536 r11949 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 !
Note: See TracChangeset
for help on using the changeset viewer.
