Changeset 13899 for NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z
- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 25 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zagg.F90
r12377 r13899 17 17 USE trc ! passive tracers common variables 18 18 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 21 21 IMPLICIT NONE … … 60 60 IF( ln_p4z ) THEN 61 61 ! 62 DO_3D _11_11(1, jpkm1 )62 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 63 63 ! 64 64 zfact = xstep * xdiss(ji,jj,jk) … … 102 102 ELSE ! ln_p5z 103 103 ! 104 DO_3D _11_11(1, jpkm1 )104 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 105 105 ! 106 106 zfact = xstep * xdiss(ji,jj,jk) … … 170 170 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 171 171 WRITE(charout, FMT="('agg')") 172 CALL prt_ctl_ trc_info(charout)173 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)172 CALL prt_ctl_info( charout, cdcomp = 'top' ) 173 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 174 174 ENDIF 175 175 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zbc.F90
r13237 r13899 112 112 IF( ll_river ) THEN 113 113 jl = n_trc_indcbc(jpno3) 114 DO_2D _11_11114 DO_2D( 1, 1, 1, 1 ) 115 115 DO jk = 1, nk_rnf(ji,jj) 116 116 zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) … … 145 145 ALLOCATE( zironice(jpi,jpj) ) 146 146 ! 147 DO_2D _11_11147 DO_2D( 1, 1, 1, 1 ) 148 148 zdep = rfact / e3t(ji,jj,1,Kmm) 149 149 zwflux = fmmflx(ji,jj) / 1000._wp … … 288 288 CALL iom_open ( TRIM( sn_ironsed%clname ), numiron ) 289 289 ALLOCATE( zcmask(jpi,jpj,jpk) ) 290 CALL iom_get ( numiron, jpdom_ data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )290 CALL iom_get ( numiron, jpdom_global, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 291 291 CALL iom_close( numiron ) 292 292 ! … … 297 297 IF(lwp) WRITE(numout,*) 298 298 IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1) 299 DO_3D _00_00(1, ik50 )299 DO_3D( 0, 0, 0, 0, 1, ik50 ) 300 300 ze3t = e3t_0(ji,jj,jk) 301 301 zsurfc = e1u(ji,jj) * ( 1. - umask(ji ,jj ,jk) ) & … … 313 313 CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged) 314 314 ! 315 DO_3D _11_11(1, jpk )315 DO_3D( 1, 1, 1, 1, 1, jpk ) 316 316 zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 317 317 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zbio.F90
r13237 r13899 30 30 USE p4zfechem 31 31 USE p4zligand ! Prognostic ligand model 32 USE prtctl _trc! print control for debugging32 USE prtctl ! print control for debugging 33 33 USE iom ! I/O manager 34 34 … … 72 72 xdiss(:,:,:) = 1. 73 73 !!gm the use of nmld should be better here? 74 DO_3D _11_11(2, jpkm1 )74 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 75 75 !!gm : use nmln and test on jk ... less memory acces 76 76 IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 … … 108 108 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 109 109 WRITE(charout, FMT="('bio ')") 110 CALL prt_ctl_ trc_info(charout)111 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)110 CALL prt_ctl_info( charout, cdcomp = 'top' ) 111 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 112 112 ENDIF 113 113 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zche.F90
r13237 r13899 179 179 ! 0.04°C relative to an exact computation 180 180 ! --------------------------------------------------------------------- 181 DO_3D _11_11(1, jpk )181 DO_3D( 1, 1, 1, 1, 1, jpk ) 182 182 zpres = gdept(ji,jj,jk,Kmm) / 1000. 183 183 za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) … … 472 472 IF( ln_timing ) CALL timing_start('ahini_for_at') 473 473 ! 474 DO_3D _11_11(1, jpk )474 DO_3D( 1, 1, 1, 1, 1, jpk ) 475 475 p_alkcb = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 476 476 p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) … … 570 570 571 571 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 572 DO_3D _11_11(1, jpk )572 DO_3D( 1, 1, 1, 1, 1, jpk ) 573 573 IF (rmask(ji,jj,jk) == 1.) THEN 574 574 p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) … … 599 599 600 600 DO jn = 1, jp_maxniter_atgen 601 DO_3D _11_11(1, jpk )601 DO_3D( 1, 1, 1, 1, 1, jpk ) 602 602 IF (rmask(ji,jj,jk) == 1.) THEN 603 603 zfact = rhop(ji,jj,jk) / 1000. + rtrn -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zfechem.F90
r13237 r13899 16 16 USE p4zche ! chemical model 17 17 USE p4zbc ! Boundary conditions from sediments 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 USE iom ! I/O manager 20 20 … … 92 92 ! Chemistry is supposed to be fast enough to be at equilibrium 93 93 ! ------------------------------------------------------------ 94 DO_3D _11_11(1, jpkm1 )94 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 95 95 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 96 96 zkeq = fekeq(ji,jj,jk) … … 107 107 108 108 zdust = 0. ! if no dust available 109 DO_3D _11_11(1, jpkm1 )109 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 110 110 ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 111 111 ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). … … 118 118 ! 119 119 zfeequi = zFe3(ji,jj,jk) * 1E-9 120 zhplus = max( rtrn, hi(ji,jj,jk) )121 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 &122 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) &123 & + fesol(ji,jj,jk,5) / zhplus )124 120 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 125 121 ! precipitation of Fe3+, creation of nanoparticles … … 177 173 IF( ln_ligand ) THEN 178 174 ! 179 DO_3D _11_11(1, jpkm1 )175 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 180 176 zlam1a = ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk) & 181 177 & + ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) … … 222 218 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 223 219 WRITE(charout, FMT="('fechem')") 224 CALL prt_ctl_ trc_info(charout)225 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)220 CALL prt_ctl_info( charout, cdcomp = 'top' ) 221 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 226 222 ENDIF 227 223 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zflx.F90
r13237 r13899 19 19 USE sms_pisces ! PISCES Source Minus Sink variables 20 20 USE p4zche ! Chemical model 21 USE prtctl _trc! print control for debugging21 USE prtctl ! print control for debugging 22 22 USE iom ! I/O manager 23 23 USE fldread ! read input fields … … 110 110 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 111 111 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 114 114 zfact = rhop(ji,jj,1) / 1000. + rtrn … … 126 126 ! ------------------------------------------- 127 127 128 DO_2D _11_11128 DO_2D( 1, 1, 1, 1 ) 129 129 ztc = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 130 130 ztc2 = ztc * ztc … … 145 145 146 146 147 DO_2D _11_11147 DO_2D( 1, 1, 1, 1 ) 148 148 ztkel = tempis(ji,jj,1) + 273.15 149 149 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. … … 178 178 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 179 179 WRITE(charout, FMT="('flx ')") 180 CALL prt_ctl_ trc_info(charout)181 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)180 CALL prt_ctl_info( charout, cdcomp = 'top' ) 181 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 182 182 ENDIF 183 183 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zligand.F90
r12377 r13899 12 12 USE trc ! passive tracers common variables 13 13 USE sms_pisces ! PISCES Source Minus Sink variables 14 USE prtctl _trc! print control for debugging14 USE prtctl ! print control for debugging 15 15 USE iom ! I/O manager 16 16 … … 52 52 IF( ln_timing ) CALL timing_start('p4z_ligand') 53 53 ! 54 DO_3D _11_11(1, jpkm1 )54 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 55 55 ! 56 56 ! ------------------------------------------------------------------ … … 89 89 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 90 90 WRITE(charout, FMT="('ligand1')") 91 CALL prt_ctl_ trc_info(charout)92 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)91 CALL prt_ctl_info( charout, cdcomp = 'top' ) 92 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 93 93 ENDIF 94 94 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zlim.F90
r12377 r13899 98 98 IF( ln_timing ) CALL timing_start('p4z_lim') 99 99 ! 100 DO_3D _11_11(1, jpkm1 )100 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 101 101 102 102 ! Tuning of the iron concentration to a minimum level that is set to the detection limit … … 161 161 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 162 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) )163 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) + rtrn ) 164 164 zratio = tr(ji,jj,jk,jpdfe,Kbb) * z1_trbdia 165 165 zironmin = xcoef1 * tr(ji,jj,jk,jpdch,Kbb) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) … … 173 173 ! Compute the fraction of nanophytoplankton that is made of calcifiers 174 174 ! -------------------------------------------------------------------- 175 DO_3D _11_11(1, jpkm1 )175 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 176 176 zlim1 = ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 ) & 177 177 & / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) ) … … 193 193 END_3D 194 194 ! 195 DO_3D _11_11(1, jpkm1 )195 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 196 196 ! denitrification factor computed from O2 levels 197 197 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zlys.F90
r12377 r13899 20 20 USE sms_pisces ! PISCES Source Minus Sink variables 21 21 USE p4zche ! Chemical model 22 USE prtctl _trc! print control for debugging22 USE prtctl ! print control for debugging 23 23 USE iom ! I/O manager 24 24 … … 75 75 CALL solve_at_general( zhinit, zhi, Kbb ) 76 76 77 DO_3D _11_11(1, jpkm1 )77 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 78 78 zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 79 79 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) … … 87 87 ! --------------------------------------------------------- 88 88 89 DO_3D _11_11(1, jpkm1 )89 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 90 90 91 91 ! DEVIATION OF [CO3--] FROM SATURATION VALUE … … 130 130 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 131 131 WRITE(charout, FMT="('lys ')") 132 CALL prt_ctl_ trc_info(charout)133 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)132 CALL prt_ctl_info( charout, cdcomp = 'top' ) 133 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 134 134 ENDIF 135 135 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zmeso.F90
r12839 r13899 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 16 USE p4zprod ! production 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 USE iom ! I/O manager 19 19 … … 81 81 IF( ln_timing ) CALL timing_start('p4z_meso') 82 82 ! 83 DO_3D _11_11(1, jpkm1 )83 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 84 84 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 85 85 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam … … 246 246 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 247 247 WRITE(charout, FMT="('meso')") 248 CALL prt_ctl_ trc_info(charout)249 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)248 CALL prt_ctl_info( charout, cdcomp = 'top' ) 249 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 250 250 ENDIF 251 251 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zmicro.F90
r12839 r13899 17 17 USE p4zprod ! production 18 18 USE iom ! I/O manager 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 21 21 IMPLICIT NONE … … 79 79 IF( ln_timing ) CALL timing_start('p4z_micro') 80 80 ! 81 DO_3D _11_11(1, jpkm1 )81 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 82 82 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 83 83 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz … … 202 202 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 203 203 WRITE(charout, FMT="('micro')") 204 CALL prt_ctl_ trc_info(charout)205 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)204 CALL prt_ctl_info( charout, cdcomp = 'top' ) 205 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 206 206 ENDIF 207 207 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zmort.F90
r12377 r13899 15 15 USE p4zprod ! Primary productivity 16 16 USE p4zlim ! Phytoplankton limitation terms 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 19 19 IMPLICIT NONE … … 77 77 ! 78 78 prodcal(:,:,:) = 0._wp ! calcite production variable set to zero 79 DO_3D _11_11(1, jpkm1 )79 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 80 80 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 81 81 ! When highly limited by macronutrients, very small cells … … 120 120 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 121 121 WRITE(charout, FMT="('nano')") 122 CALL prt_ctl_ trc_info(charout)123 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)122 CALL prt_ctl_info( charout, cdcomp = 'top' ) 123 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 124 124 ENDIF 125 125 ! … … 152 152 ! ------------------------------------------------------------ 153 153 154 DO_3D _11_11(1, jpkm1 )154 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 155 155 156 156 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) … … 192 192 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 193 193 WRITE(charout, FMT="('diat')") 194 CALL prt_ctl_ trc_info(charout)195 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)194 CALL prt_ctl_info( charout, cdcomp = 'top' ) 195 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 196 196 ENDIF 197 197 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zopt.F90
r13237 r13899 16 16 USE iom ! I/O manager 17 17 USE fldread ! time interpolation 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 20 20 IMPLICIT NONE … … 37 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) 39 40 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m)41 42 REAL(wp), DIMENSION(3,61) :: xkrgb ! tabulated attenuation coefficients for RGB absorption43 39 44 40 !! * Substitutions … … 89 85 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 90 86 ! 91 DO_3D _11_11(1, jpkm1 )87 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 92 88 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 93 89 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 94 90 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 95 91 ! 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)92 ekb(ji,jj,jk) = rkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 93 ekg(ji,jj,jk) = rkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 94 ekr(ji,jj,jk) = rkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 99 95 END_3D 100 96 ! !* Photosynthetically Available Radiation (PAR) … … 106 102 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 107 103 ! 108 DO jk = 1, nksr p104 DO jk = 1, nksr 109 105 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 110 106 enano (:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) … … 112 108 END DO 113 109 IF( ln_p5z ) THEN 114 DO jk = 1, nksr p110 DO jk = 1, nksr 115 111 epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 116 112 END DO … … 121 117 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 ) 122 118 ! 123 DO jk = 1, nksr p119 DO jk = 1, nksr 124 120 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 125 121 END DO … … 131 127 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 132 128 ! 133 DO jk = 1, nksr p129 DO jk = 1, nksr 134 130 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 135 131 enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) … … 137 133 END DO 138 134 IF( ln_p5z ) THEN 139 DO jk = 1, nksr p135 DO jk = 1, nksr 140 136 epico(:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 141 137 END DO … … 150 146 ! 151 147 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 152 DO jk = 2, nksr p+ 1148 DO jk = 2, nksr + 1 153 149 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 154 150 END DO … … 160 156 heup_01(:,:) = gdepw(:,:,2,Kmm) 161 157 162 DO_3D _11_11( 2, nksrp)158 DO_3D( 1, 1, 1, 1, 2, nksr ) 163 159 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 164 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer … … 178 174 zetmp2 (:,:) = 0.e0 179 175 180 DO_3D _11_11( 1, nksrp)176 DO_3D( 1, 1, 1, 1, 1, nksr ) 181 177 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 182 178 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation … … 189 185 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 190 186 ! 191 DO_3D _11_11( 1, nksrp)187 DO_3D( 1, 1, 1, 1, 1, nksr ) 192 188 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 193 189 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 201 197 zetmp4 (:,:) = 0.e0 202 198 ! 203 DO_3D _11_11( 1, nksrp)199 DO_3D( 1, 1, 1, 1, 1, nksr ) 204 200 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 205 201 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 211 207 ediatm(:,:,:) = ediat(:,:,:) 212 208 ! 213 DO_3D _11_11( 1, nksrp)209 DO_3D( 1, 1, 1, 1, 1, nksr ) 214 210 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 215 211 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 221 217 IF( ln_p5z ) THEN 222 218 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 223 DO_3D _11_11( 1, nksrp)219 DO_3D( 1, 1, 1, 1, 1, nksr ) 224 220 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 225 221 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 229 225 epicom(:,:,:) = epico(:,:,:) 230 226 ! 231 DO_3D _11_11( 1, nksrp)227 DO_3D( 1, 1, 1, 1, 1, nksr ) 232 228 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 233 229 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 283 279 pe3(:,:,1) = zqsr(:,:) 284 280 ! 285 DO jk = 2, nksr p+ 1281 DO jk = 2, nksr + 1 286 282 DO jj = 1, jpj 287 283 DO ji = 1, jpi … … 302 298 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 303 299 ! 304 DO_3D _11_11( 2, nksrp)300 DO_3D( 1, 1, 1, 1, 2, nksr ) 305 301 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 306 302 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) … … 400 396 ntimes_par = iom_getszuld( numpar ) ! get number of record in file 401 397 ENDIF 402 !403 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients404 nksrp = trc_oce_ext_lev( r_si2, 0.33e2_wp ) ! max level of light extinction (Blue Chl=0.01)405 !406 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'407 398 ! 408 399 ekr (:,:,:) = 0._wp -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zpoc.F90
r13237 r13899 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 USE iom ! I/O manager 19 19 … … 107 107 ! ----------------------------------------------------------------------- 108 108 ztremint(:,:,:) = zremigoc(:,:,:) 109 DO_3D _11_11(2, jpkm1 )109 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 110 110 IF (tmask(ji,jj,jk) == 1.) THEN 111 111 zdep = hmld(ji,jj) … … 192 192 193 193 IF( ln_p4z ) THEN 194 DO_3D _11_11(1, jpkm1 )194 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 195 195 ! POC disaggregation by turbulence and bacterial activity. 196 196 ! -------------------------------------------------------- … … 212 212 END_3D 213 213 ELSE 214 DO_3D _11_11(1, jpkm1 )214 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 215 215 ! POC disaggregation by turbulence and bacterial activity. 216 216 ! -------------------------------------------------------- … … 242 242 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 243 243 WRITE(charout, FMT="('poc1')") 244 CALL prt_ctl_ trc_info(charout)245 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)244 CALL prt_ctl_info( charout, cdcomp = 'top' ) 245 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 246 246 ENDIF 247 247 … … 260 260 ! ---------------------------------------------------------------- 261 261 ! 262 DO_3D _11_11(1, jpkm1 )262 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 263 263 zdep = hmld(ji,jj) 264 264 IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN … … 275 275 ! --------------------------------------------------------------------- 276 276 ztremint(:,:,:) = zremipoc(:,:,:) 277 DO_3D _11_11(1, jpkm1 )277 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 278 278 IF (tmask(ji,jj,jk) == 1.) THEN 279 279 zdep = hmld(ji,jj) … … 310 310 ! ----------------------------------------------------------------------- 311 311 ! 312 DO_3D _11_11(2, jpkm1 )312 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 313 313 IF (tmask(ji,jj,jk) == 1.) THEN 314 314 zdep = hmld(ji,jj) … … 384 384 385 385 IF( ln_p4z ) THEN 386 DO_3D _11_11(1, jpkm1 )386 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 387 387 IF (tmask(ji,jj,jk) == 1.) THEN 388 388 ! POC disaggregation by turbulence and bacterial activity. … … 401 401 END_3D 402 402 ELSE 403 DO_3D _11_11(1, jpkm1 )403 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 404 404 ! POC disaggregation by turbulence and bacterial activity. 405 405 ! -------------------------------------------------------- … … 434 434 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 435 435 WRITE(charout, FMT="('poc2')") 436 CALL prt_ctl_ trc_info(charout)437 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)436 CALL prt_ctl_info( charout, cdcomp = 'top' ) 437 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 438 438 ENDIF 439 439 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zprod.F90
r13237 r13899 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 17 USE p4zlim ! Co-limitations of differents nutrients 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 USE iom ! I/O manager 20 20 … … 110 110 ! day length in hours 111 111 zstrn(:,:) = 0. 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 114 114 zargu = MAX( -1., MIN( 1., zargu ) ) … … 117 117 118 118 ! Impact of the day duration and light intermittency on phytoplankton growth 119 DO_3D _11_11(1, jpkm1 )119 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 120 120 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 121 121 zval = MAX( 1., zstrn(ji,jj) ) … … 135 135 136 136 ! Computation of the P-I slope for nanos and diatoms 137 DO_3D _11_11(1, jpkm1 )137 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 138 138 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 139 139 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) … … 150 150 END_3D 151 151 152 DO_3D _11_11(1, jpkm1 )152 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 153 153 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 154 154 ! Computation of production function for Carbon … … 171 171 ! Computation of a proxy of the N/C ratio 172 172 ! --------------------------------------- 173 DO_3D _11_11(1, jpkm1 )173 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 174 174 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & 175 175 & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) … … 181 181 182 182 183 DO_3D _11_11(1, jpkm1 )183 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 184 184 185 185 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN … … 205 205 ! Sea-ice effect on production 206 206 207 DO_3D _11_11(1, jpkm1 )207 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 208 208 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 209 209 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) … … 211 211 212 212 ! Computation of the various production terms 213 DO_3D _11_11(1, jpkm1 )213 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 214 214 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 215 215 ! production terms for nanophyto. (C) … … 237 237 238 238 ! Computation of the chlorophyll production terms 239 DO_3D _11_11(1, jpkm1 )239 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 240 240 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 241 241 ! production terms for nanophyto. ( chlorophyll ) … … 260 260 261 261 ! Update the arrays TRA which contain the biological sources and sinks 262 DO_3D _11_11(1, jpkm1 )262 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 263 263 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 264 264 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) … … 288 288 IF( ln_ligand ) THEN 289 289 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 290 DO_3D _11_11(1, jpkm1 )290 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 291 291 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 292 292 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) … … 331 331 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 332 332 WRITE(charout, FMT="('prod')") 333 CALL prt_ctl_ trc_info(charout)334 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)333 CALL prt_ctl_info( charout, cdcomp = 'top' ) 334 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 335 335 ENDIF 336 336 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zrem.F90
r13237 r13899 18 18 USE p4zprod ! Growth rate of the 2 phyto groups 19 19 USE p4zlim 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 USE iom ! I/O manager 22 22 … … 89 89 ! that was modeling explicitely bacteria 90 90 ! ------------------------------------------------------- 91 DO_3D _11_11(1, jpkm1 )91 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 92 92 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 93 93 IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN … … 103 103 104 104 IF( ln_p4z ) THEN 105 DO_3D _11_11(1, jpkm1 )105 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 106 106 ! DOC ammonification. Depends on depth, phytoplankton biomass 107 107 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. … … 134 134 END_3D 135 135 ELSE 136 DO_3D _11_11(1, jpkm1 )136 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 137 137 ! DOC ammonification. Depends on depth, phytoplankton biomass 138 138 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. … … 178 178 179 179 180 DO_3D _11_11(1, jpkm1 )180 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 181 181 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 182 182 ! below 2 umol/L. Inhibited at strong light … … 196 196 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 197 197 WRITE(charout, FMT="('rem1')") 198 CALL prt_ctl_ trc_info(charout)199 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)198 CALL prt_ctl_info( charout, cdcomp = 'top' ) 199 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 200 200 ENDIF 201 201 202 DO_3D _11_11(1, jpkm1 )202 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 203 203 204 204 ! Bacterial uptake of iron. No iron is available in DOC. So … … 218 218 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 219 219 WRITE(charout, FMT="('rem2')") 220 CALL prt_ctl_ trc_info(charout)221 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)220 CALL prt_ctl_info( charout, cdcomp = 'top' ) 221 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 222 222 ENDIF 223 223 … … 226 226 ! --------------------------------------------------------------- 227 227 228 DO_3D _11_11(1, jpkm1 )228 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 229 229 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 230 230 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) … … 249 249 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 250 250 WRITE(charout, FMT="('rem3')") 251 CALL prt_ctl_ trc_info(charout)252 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)251 CALL prt_ctl_info( charout, cdcomp = 'top' ) 252 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 253 253 ENDIF 254 254 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zsed.F90
r13237 r13899 18 18 USE sed ! Sediment module 19 19 USE iom ! I/O manager 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 22 22 IMPLICIT NONE … … 94 94 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 95 95 ! -------------------------------------------------------------------- 96 DO_2D _11_1196 DO_2D( 1, 1, 1, 1 ) 97 97 ikt = mbkt(ji,jj) 98 98 zdep = e3t(ji,jj,ikt,Kmm) / xstep … … 104 104 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 105 105 ! ------------------------------------------------------- 106 DO_2D _11_11106 DO_2D( 1, 1, 1, 1 ) 107 107 IF( tmask(ji,jj,1) == 1 ) THEN 108 108 ikt = mbkt(ji,jj) … … 130 130 IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac 131 131 132 DO_2D _11_11132 DO_2D( 1, 1, 1, 1 ) 133 133 ikt = mbkt(ji,jj) 134 134 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 142 142 ! 143 143 IF( .NOT.lk_sed ) THEN 144 DO_2D _11_11144 DO_2D( 1, 1, 1, 1 ) 145 145 ikt = mbkt(ji,jj) 146 146 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 160 160 ENDIF 161 161 ! 162 DO_2D _11_11162 DO_2D( 1, 1, 1, 1 ) 163 163 ikt = mbkt(ji,jj) 164 164 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 172 172 ! 173 173 IF( ln_p5z ) THEN 174 DO_2D _11_11174 DO_2D( 1, 1, 1, 1 ) 175 175 ikt = mbkt(ji,jj) 176 176 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 187 187 ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 188 188 ! denitrification in the sediments. Not very clever, but simpliest option. 189 DO_2D _11_11189 DO_2D( 1, 1, 1, 1 ) 190 190 ikt = mbkt(ji,jj) 191 191 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 224 224 ENDDO 225 225 IF( ln_p4z ) THEN 226 DO_3D _11_11(1, jpkm1 )226 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 227 227 ! ! Potential nitrogen fixation dependant on temperature and iron 228 228 ztemp = ts(ji,jj,jk,jp_tem,Kmm) … … 240 240 END_3D 241 241 ELSE ! p5z 242 DO_3D _11_11(1, jpkm1 )242 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 243 243 ! ! Potential nitrogen fixation dependant on temperature and iron 244 244 ztemp = ts(ji,jj,jk,jp_tem,Kmm) … … 261 261 ! ---------------------------------------- 262 262 IF( ln_p4z ) THEN 263 DO_3D _11_11(1, jpkm1 )263 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 264 264 zfact = nitrpot(ji,jj,jk) * nitrfix 265 265 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 … … 278 278 END_3D 279 279 ELSE ! p5z 280 DO_3D _11_11(1, jpkm1 )280 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 281 281 zfact = nitrpot(ji,jj,jk) * nitrfix 282 282 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 … … 313 313 ENDIF 314 314 ! 315 IF(sn_cfctl%l_prttrc) THEN ! print mean tr ends (USEd for debugging)315 IF(sn_cfctl%l_prttrc) THEN ! print mean trneds (USEd for debugging) 316 316 WRITE(charout, fmt="('sed ')") 317 CALL prt_ctl_ trc_info(charout)318 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)317 CALL prt_ctl_info( charout, cdcomp = 'top' ) 318 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 319 319 ENDIF 320 320 ! … … 366 366 lk_sed = ln_sediment .AND. ln_sed_2way 367 367 ! 368 nitrpot(:,:,jpk) = 0._wp ! define last level for iom_put 369 ! 368 370 END SUBROUTINE p4z_sed_init 369 371 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zsink.F90
r13237 r13899 17 17 USE sms_pisces ! PISCES Source Minus Sink variables 18 18 USE trcsink ! General routine to compute sedimentation 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 USE iom ! I/O manager 21 21 USE lib_mpp … … 81 81 ! by data and from the coagulation theory 82 82 ! ----------------------------------------------------------- 83 DO_3D _11_11(1, jpkm1 )83 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 84 84 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 85 85 zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale … … 144 144 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 145 145 WRITE(charout, FMT="('sink')") 146 CALL prt_ctl_ trc_info(charout)147 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)146 CALL prt_ctl_info( charout, cdcomp = 'top' ) 147 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 148 148 ENDIF 149 149 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zsms.F90
r13237 r13899 25 25 USE trdtrc ! TOP trends variables 26 26 USE sedmodel ! Sediment model 27 USE prtctl _trc! print control for debugging27 USE prtctl ! print control for debugging 28 28 29 29 IMPLICIT NONE … … 69 69 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d 70 70 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zw3d 71 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace71 REAL(wp), DIMENSION(jpi,jpj,jpk,jp_pisces) :: ztrbbio 72 72 73 73 !!--------------------------------------------------------------------- … … 93 93 rfact = rDt_trc 94 94 ! 95 ! trends computation initialisation96 IF( l_trdtrc ) THEN97 ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) ) !* store now fields before applying the Asselin filter98 ztrdt(:,:,:,:) = tr(:,:,:,:,Kmm)99 ENDIF100 !101 102 95 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 103 96 rfactr = 1. / rfact … … 117 110 END DO 118 111 ENDIF 112 113 DO jn = jp_pcs0, jp_pcs1 ! Store the tracer concentrations before entering PISCES 114 ztrbbio(:,:,:,jn) = tr(:,:,:,jn,Kbb) 115 END DO 116 119 117 ! 120 118 IF( ll_bc ) CALL p4z_bc( kt, Kbb, Kmm, Krhs ) ! external sources of nutrients … … 133 131 xnegtr(:,:,:) = 1.e0 134 132 DO jn = jp_pcs0, jp_pcs1 135 DO_3D _11_11(1, jpk )133 DO_3D( 1, 1, 1, 1, 1, jpk ) 136 134 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 137 135 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) … … 198 196 END DO 199 197 ! 200 IF( ln_top_euler ) THEN 201 DO jn = jp_pcs0, jp_pcs1 202 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 203 END DO 204 ENDIF 198 END DO 199 ! 200 #endif 201 ! 202 IF( ln_sediment ) THEN 203 ! 204 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 205 ! 206 ENDIF 207 ! 208 DO jn = jp_pcs0, jp_pcs1 209 tr(:,:,:,jn,Krhs) = ( tr(:,:,:,jn,Kbb) - ztrbbio(:,:,:,jn) ) * rfactr 210 tr(:,:,:,jn,Kbb ) = ztrbbio(:,:,:,jn) 211 ztrbbio(:,:,:,jn) = 0._wp 205 212 END DO 206 213 ! 207 214 IF( l_trdtrc ) THEN 208 215 DO jn = jp_pcs0, jp_pcs1 209 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr210 216 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 211 217 END DO 212 DEALLOCATE( ztrdt )213 218 END IF 214 #endif 215 ! 216 IF( ln_sediment ) THEN 217 ! 218 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 219 ! 220 IF( ln_top_euler ) THEN 221 DO jn = jp_pcs0, jp_pcs1 222 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 223 END DO 224 ENDIF 225 ! 226 ENDIF 227 ! 219 ! 228 220 IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file 229 221 ! … … 341 333 ! 342 334 IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 343 CALL iom_get( numrtr, jpdom_auto glo, 'PH' , hi(:,:,:) )335 CALL iom_get( numrtr, jpdom_auto, 'PH' , hi(:,:,:) ) 344 336 ELSE 345 337 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 346 338 CALL ahini_for_at( hi, Kbb ) 347 339 ENDIF 348 CALL iom_get( numrtr, jpdom_auto glo, 'Silicalim', xksi(:,:) )340 CALL iom_get( numrtr, jpdom_auto, 'Silicalim', xksi(:,:) ) 349 341 IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 350 CALL iom_get( numrtr, jpdom_auto glo, 'Silicamax' , xksimax(:,:) )342 CALL iom_get( numrtr, jpdom_auto, 'Silicamax' , xksimax(:,:) ) 351 343 ELSE 352 344 xksimax(:,:) = xksi(:,:) … … 361 353 IF( ln_p5z ) THEN 362 354 IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 363 CALL iom_get( numrtr, jpdom_auto glo, 'sizep' , sizep(:,:,:) )364 CALL iom_get( numrtr, jpdom_auto glo, 'sizen' , sizen(:,:,:) )365 CALL iom_get( numrtr, jpdom_auto glo, 'sized' , sized(:,:,:) )355 CALL iom_get( numrtr, jpdom_auto, 'sizep' , sizep(:,:,:) ) 356 CALL iom_get( numrtr, jpdom_auto, 'sizen' , sizen(:,:,:) ) 357 CALL iom_get( numrtr, jpdom_auto, 'sized' , sized(:,:,:) ) 366 358 ELSE 367 359 sizep(:,:,:) = 1. -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p5zlim.F90
r12377 r13899 131 131 zratchl = 6.0 132 132 ! 133 DO_3D _11_11(1, jpkm1 )133 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 134 134 ! 135 135 ! Tuning of the iron concentration to a minimum level that is set to the detection limit … … 306 306 & / (xqndmax(ji,jj,jk) - 2. * xqndmin(ji,jj,jk) ) ) & 307 307 & * xqndmax(ji,jj,jk) / (zration + rtrn) 308 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) )308 zlim3 = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi(ji,jj) + rtrn ) 309 309 zlim4 = MAX( 0., ( zratiof - zqfemd ) / qfdopt ) 310 310 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) … … 318 318 ! phytoplankton (see Daines et al., 2013). 319 319 ! -------------------------------------------------------------------------------------------------- 320 DO_3D _11_11(1, jpkm1 )320 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 321 321 ! Size estimation of nanophytoplankton 322 322 ! ------------------------------------ … … 367 367 ! Compute the fraction of nanophytoplankton that is made of calcifiers 368 368 ! -------------------------------------------------------------------- 369 DO_3D _11_11(1, jpkm1 )369 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 370 370 zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) & 371 371 & / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) & … … 385 385 END_3D 386 386 ! 387 DO_3D _11_11(1, jpkm1 )387 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 388 388 ! denitrification factor computed from O2 levels 389 389 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p5zmeso.F90
r12377 r13899 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 USE iom ! I/O manager 19 19 … … 98 98 IF ( bmetexc2 ) zmetexcess = 1.0 99 99 100 DO_3D _11_11(1, jpkm1 )100 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 101 101 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 102 102 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam … … 359 359 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 360 360 WRITE(charout, FMT="('meso')") 361 CALL prt_ctl_ trc_info(charout)362 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)361 CALL prt_ctl_info( charout, cdcomp = 'top' ) 362 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 363 363 ENDIF 364 364 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p5zmicro.F90
r12377 r13899 18 18 USE p5zlim ! Phytoplankton limitation terms 19 19 USE iom ! I/O manager 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 22 22 IMPLICIT NONE … … 96 96 IF ( bmetexc ) zmetexcess = 1.0 97 97 ! 98 DO_3D _11_11(1, jpkm1 )98 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 99 99 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 100 100 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz … … 306 306 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 307 307 WRITE(charout, FMT="('micro')") 308 CALL prt_ctl_ trc_info(charout)309 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)308 CALL prt_ctl_info( charout, cdcomp = 'top' ) 309 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 310 310 ENDIF 311 311 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p5zmort.F90
r12377 r13899 16 16 USE p4zlim 17 17 USE p5zlim ! Phytoplankton limitation terms 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 20 20 IMPLICIT NONE … … 82 82 ! 83 83 prodcal(:,:,:) = 0. !: calcite production variable set to zero 84 DO_3D _11_11(1, jpkm1 )84 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 85 85 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 86 86 ! Squared mortality of Phyto similar to a sedimentation term during … … 121 121 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 122 122 WRITE(charout, FMT="('nano')") 123 CALL prt_ctl_ trc_info(charout)124 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)123 CALL prt_ctl_info( charout, cdcomp = 'top' ) 124 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 125 125 ENDIF 126 126 ! … … 148 148 IF( ln_timing ) CALL timing_start('p5z_pico') 149 149 ! 150 DO_3D _11_11(1, jpkm1 )150 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 151 151 zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 152 152 ! Squared mortality of Phyto similar to a sedimentation term during … … 179 179 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 180 180 WRITE(charout, FMT="('pico')") 181 CALL prt_ctl_ trc_info(charout)182 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)181 CALL prt_ctl_info( charout, cdcomp = 'top' ) 182 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 183 183 ENDIF 184 184 ! … … 207 207 ! 208 208 209 DO_3D _11_11(1, jpkm1 )209 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 210 210 211 211 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) … … 254 254 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 255 255 WRITE(charout, FMT="('diat')") 256 CALL prt_ctl_ trc_info(charout)257 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)256 CALL prt_ctl_info( charout, cdcomp = 'top' ) 257 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 258 258 ENDIF 259 259 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p5zprod.F90
r13237 r13899 18 18 USE p4zlim 19 19 USE p5zlim ! Co-limitations of differents nutrients 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 USE iom ! I/O manager 22 22 … … 125 125 ! day length in hours 126 126 zstrn(:,:) = 0. 127 DO_2D _11_11127 DO_2D( 1, 1, 1, 1 ) 128 128 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 129 129 zargu = MAX( -1., MIN( 1., zargu ) ) … … 132 132 133 133 ! Impact of the day duration on phytoplankton growth 134 DO_3D _11_11(1, jpkm1 )134 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 135 135 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 136 136 zval = MAX( 1., zstrn(ji,jj) ) … … 152 152 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 153 153 154 DO_3D _11_11(1, jpkm1 )154 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 155 155 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 156 156 ! Computation of the P-I slope for nanos and diatoms … … 186 186 END_3D 187 187 188 DO_3D _11_11(1, jpkm1 )188 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 189 189 190 190 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN … … 208 208 209 209 ! Sea-ice effect on production 210 DO_3D _11_11(1, jpkm1 )210 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 211 211 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 212 212 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) … … 216 216 217 217 ! Computation of the various production terms of nanophytoplankton 218 DO_3D _11_11(1, jpkm1 )218 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 219 219 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 220 220 ! production terms for nanophyto. … … 249 249 250 250 ! Computation of the various production terms of picophytoplankton 251 DO_3D _11_11(1, jpkm1 )251 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 252 252 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 253 253 ! production terms for picophyto. … … 282 282 283 283 ! Computation of the various production terms of diatoms 284 DO_3D _11_11(1, jpkm1 )284 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 285 285 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 286 286 ! production terms for diatomees … … 316 316 END_3D 317 317 318 DO_3D _11_11(1, jpkm1 )318 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 319 319 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 320 320 ! production terms for nanophyto. ( chlorophyll ) … … 347 347 348 348 ! Update the arrays TRA which contain the biological sources and sinks 349 DO_3D _11_11(1, jpkm1 )349 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 350 350 zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 351 351 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) … … 410 410 IF( ln_ligand ) THEN 411 411 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 412 DO_3D _11_11(1, jpkm1 )412 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 413 413 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 414 414 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) … … 461 461 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 462 462 WRITE(charout, FMT="('prod')") 463 CALL prt_ctl_ trc_info(charout)464 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)463 CALL prt_ctl_info( charout, cdcomp = 'top' ) 464 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 465 465 ENDIF 466 466 !
Note: See TracChangeset
for help on using the changeset viewer.