Changeset 13899 for NEMO/branches/2020/tickets_icb_1900/src/TOP
- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 1 deleted
- 62 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/TOP/C14/trcatm_c14.F90
r12489 r13899 120 120 IF( ierr3 /= 0 ) CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) 121 121 ! 122 DO_2D _11_11122 DO_2D( 1, 1, 1, 1 ) ! from C14b package 123 123 IF( gphit(ji,jj) >= yn40 ) THEN 124 124 fareaz(ji,jj,1) = 0. -
NEMO/branches/2020/tickets_icb_1900/src/TOP/C14/trcini_c14.F90
r12377 r13899 69 69 ! 70 70 CALL iom_get( numrtr, 'co2sbc', co2sbc ) 71 CALL iom_get( numrtr, jpdom_auto glo, 'c14sbc', c14sbc )72 CALL iom_get( numrtr, jpdom_auto glo, 'exch_co2', exch_co2 )73 CALL iom_get( numrtr, jpdom_auto glo, 'exch_c14', exch_c14 )74 CALL iom_get( numrtr, jpdom_auto glo, 'qtr_c14', qtr_c14 )71 CALL iom_get( numrtr, jpdom_auto, 'c14sbc', c14sbc ) 72 CALL iom_get( numrtr, jpdom_auto, 'exch_co2', exch_co2 ) 73 CALL iom_get( numrtr, jpdom_auto, 'exch_c14', exch_c14 ) 74 CALL iom_get( numrtr, jpdom_auto, 'qtr_c14', qtr_c14 ) 75 75 ! 76 76 END IF … … 85 85 ELSE 86 86 ! 87 CALL iom_get( numrtr, jpdom_auto glo, 'qint_c14', qint_c14 )87 CALL iom_get( numrtr, jpdom_auto, 'qint_c14', qint_c14 ) 88 88 ! 89 89 ENDIF -
NEMO/branches/2020/tickets_icb_1900/src/TOP/C14/trcsms_c14.F90
r13237 r13899 81 81 ! ------------------------------------------------------------------- 82 82 83 DO_2D _11_1183 DO_2D( 1, 1, 1, 1 ) 84 84 IF( tmask(ji,jj,1) > 0. ) THEN 85 85 ! … … 128 128 ! 129 129 ! Add the surface flux to the trend of jp_c14 130 DO_2D _11_11130 DO_2D( 1, 1, 1, 1 ) 131 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_2D 133 133 ! 134 134 ! Computation of decay effects on jp_c14 135 DO_3D _11_11(1, jpk )135 DO_3D( 1, 1, 1, 1, 1, jpk ) 136 136 ! 137 137 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) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/C14/trcwri_c14.F90
r12377 r13899 60 60 zz3d(:,:,:) = 0._wp 61 61 ! 62 DO_3D _11_11(1, jpkm1 )62 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 63 63 IF( tmask(ji,jj,jk) > 0._wp) THEN 64 64 z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) … … 71 71 z2d(:,:) =0._wp 72 72 jk = 1 73 DO_2D _11_1173 DO_2D( 1, 1, 1, 1 ) 74 74 ztemp = zres(ji,jj) / c14sbc(ji,jj) 75 75 IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/CFC/trcini_cfc.F90
r12377 r13899 132 132 !--------------------------------------------------------------------------------------- 133 133 zyd = ylatn - ylats 134 DO_2D _11_11134 DO_2D( 1, 1, 1, 1 ) 135 135 IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0 136 136 ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/CFC/trcsms_cfc.F90
r13237 r13899 126 126 127 127 ! !------------! 128 DO_2D _11_11129 128 DO_2D( 1, 1, 1, 1 ) ! i-j loop ! 129 ! !------------! 130 130 ! space interpolation 131 131 zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & … … 298 298 DO jn = jp_cfc0, jp_cfc1 299 299 jl = jl + 1 300 CALL iom_get( numrtr, jpdom_auto glo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )300 CALL iom_get( numrtr, jpdom_auto, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 301 301 END DO 302 302 ENDIF -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P2Z/p2zbio.F90
r13237 r13899 19 19 ! 20 20 USE lbclnk ! 21 USE prtctl _trc! Print control for debbuging21 USE prtctl ! Print control for debbuging 22 22 USE iom ! 23 23 … … 122 122 DO jk = 1, jpkbm1 ! Upper ocean (bio-layers) ! 123 123 ! ! -------------------------- ! 124 DO_2D _00_00124 DO_2D( 0, 0, 0, 0 ) 125 125 ! trophic variables( det, zoo, phy, no3, nh4, dom) 126 126 ! ------------------------------------------------ … … 242 242 DO jk = jpkb, jpkm1 ! Upper ocean (bio-layers) ! 243 243 ! ! -------------------------- ! 244 DO_2D _00_00244 DO_2D( 0, 0, 0, 0 ) 245 245 ! remineralisation of all quantities towards nitrate 246 246 … … 367 367 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 368 368 WRITE(charout, FMT="('bio')") 369 CALL prt_ctl_ trc_info(charout)370 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)369 CALL prt_ctl_info( charout, cdcomp = 'top' ) 370 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 371 371 ENDIF 372 372 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P2Z/p2zexp.F90
r13237 r13899 17 17 USE p2zsed 18 18 USE lbclnk 19 USE prtctl _trc! Print control for debbuging19 USE prtctl ! Print control for debbuging 20 20 USE trd_oce 21 21 USE trdtrc … … 82 82 ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 83 83 ! ---------------------------------------------------------------------- 84 DO_3D _00_00(1, jpkm1 )84 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 85 85 ze3t = 1. / e3t(ji,jj,jk,Kmm) 86 86 tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) … … 93 93 zgeolpoc = 0.e0 ! Initialization 94 94 ! Release of nutrients from the "simple" sediment 95 DO_2D _00_0095 DO_2D( 0, 0, 0, 0 ) 96 96 ikt = mbkt(ji,jj) 97 97 tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) … … 103 103 END_2D 104 104 105 DO_2D _00_00105 DO_2D( 0, 0, 0, 0 ) 106 106 tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 107 107 END_2D … … 121 121 ELSE 122 122 ! 123 DO_2D _11_11123 DO_2D( 1, 1, 1, 1 ) 124 124 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers 125 125 sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd ! sedpocb <-- filtered sedpocn … … 140 140 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 141 141 WRITE(charout, FMT="('exp')") 142 CALL prt_ctl_ trc_info(charout)143 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)142 CALL prt_ctl_info( charout, cdcomp = 'top' ) 143 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 144 144 ENDIF 145 145 ! … … 174 174 zdm0 = 0._wp 175 175 zrro = 1._wp 176 DO_3D _11_11(jpkb, jpkm1 )176 DO_3D( 1, 1, 1, 1, jpkb, jpkm1 ) 177 177 zfluo = ( gdepw(ji,jj,jk ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 178 178 zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr … … 191 191 dminl(:,:) = 0._wp 192 192 dmin3(:,:,:) = zdm0 193 DO_3D _11_11(1, jpk )193 DO_3D( 1, 1, 1, 1, 1, jpk ) 194 194 IF( tmask(ji,jj,jk) == 0._wp ) THEN 195 195 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) … … 198 198 END_3D 199 199 200 DO_2D _11_11200 DO_2D( 1, 1, 1, 1 ) 201 201 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 202 202 END_2D … … 204 204 ! Coastal mask 205 205 cmask(:,:) = 0._wp 206 DO_2D _00_00206 DO_2D( 0, 0, 0, 0 ) 207 207 IF( tmask(ji,jj,1) /= 0. ) THEN 208 208 zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) … … 214 214 ! 215 215 IF( ln_rsttr ) THEN 216 CALL iom_get( numrtr, jpdom_auto glo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )217 CALL iom_get( numrtr, jpdom_auto glo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )216 CALL iom_get( numrtr, jpdom_auto, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 217 CALL iom_get( numrtr, jpdom_auto, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 218 218 ELSE 219 219 sedpocb(:,:) = 0._wp -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P2Z/p2zopt.F90
r13237 r13899 18 18 USE trc 19 19 USE sms_pisces 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 22 22 IMPLICIT NONE … … 95 95 ! ! Photosynthetically Available Radiation (PAR) 96 96 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- 97 DO_3D _11_11( 2, jpk )97 DO_3D( 1, 1, 1, 1, 2, jpk ) ! local par at w-levels 98 98 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef ) 99 99 zkr = xkr0 + xkrp * EXP( xlr * zpig ) … … 102 102 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 103 103 END_3D 104 DO_3D _11_11( 1, jpkm1 )104 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! mean par at t-levels 105 105 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef ) 106 106 zkr = xkr0 + xkrp * EXP( xlr * zpig ) … … 114 114 ! ! -------------- 115 115 neln(:,:) = 1 ! euphotic layer level 116 DO_3D _11_11( 1, jpkm1)116 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! (i.e. 1rst T-level strictly below EL bottom) 117 117 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 118 118 END_3D 119 119 ! ! Euphotic layer depth 120 DO_2D _11_11120 DO_2D( 1, 1, 1, 1 ) 121 121 heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 122 122 END_2D … … 125 125 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 126 126 WRITE(charout, FMT="('opt')") 127 CALL prt_ctl_ trc_info( charout)128 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )127 CALL prt_ctl_info( charout, cdcomp = 'top' ) 128 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 129 129 ENDIF 130 130 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P2Z/p2zsed.F90
r13237 r13899 18 18 USE lbclnk ! 19 19 USE iom ! 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 22 22 IMPLICIT NONE … … 89 89 90 90 ! tracer flux divergence at t-point added to the general trend 91 DO_3D _11_11(1, jpkm1 )91 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 92 92 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 93 93 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk) … … 109 109 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 110 110 WRITE(charout, FMT="('sed')") 111 CALL prt_ctl_ trc_info(charout)112 CALL prt_ctl _trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)111 CALL prt_ctl_info( charout, cdcomp = 'top' ) 112 CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 113 113 ENDIF 114 114 ! -
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 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/SED/sedchem.F90
r12839 r13899 138 138 CALL sed_chem_cst 139 139 ELSE 140 DO_2D _11_11140 DO_2D( 1, 1, 1, 1 ) 141 141 ikt = mbkt(ji,jj) 142 142 IF ( tmask(ji,jj,ikt) == 1 ) THEN -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/SED/seddta.F90
r13237 r13899 96 96 ! ----------------------------------------------------------- 97 97 IF (ln_sediment_offline) THEN 98 DO_2D _11_1198 DO_2D( 1, 1, 1, 1 ) 99 99 ikt = mbkt(ji,jj) 100 100 zwsbio4(ji,jj) = wsbio2 / rday … … 102 102 END_2D 103 103 ELSE 104 DO_2D _11_11104 DO_2D( 1, 1, 1, 1 ) 105 105 ikt = mbkt(ji,jj) 106 106 zdep = e3t(ji,jj,ikt,Kmm) / rDt_trc … … 111 111 112 112 trc_data(:,:,:) = 0. 113 DO_2D _11_11113 DO_2D( 1, 1, 1, 1 ) 114 114 ikt = mbkt(ji,jj) 115 115 IF ( tmask(ji,jj,ikt) == 1 ) THEN -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/SED/sedini.F90
r12489 r13899 135 135 ! Determination of sediments number of points and allocate global variables 136 136 epkbot(:,:) = 0. 137 DO_2D _11_11137 DO_2D( 1, 1, 1, 1 ) 138 138 ikt = mbkt(ji,jj) 139 139 IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_1d(ikt) … … 247 247 ! Computation of 1D array of sediments points 248 248 indoce = 0 249 DO_2D _11_11249 DO_2D( 1, 1, 1, 1 ) 250 250 IF ( epkbot(ji,jj) > 0. ) THEN 251 251 indoce = indoce + 1 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/SED/sedrst.F90
r12649 r13899 123 123 cltra = TRIM(sedtrcd(jn)) 124 124 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 125 CALL iom_get( numrsr, jpdom_auto glo, TRIM(cltra), zdta(:,:,:,jn) )125 CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta(:,:,:,jn) ) 126 126 ELSE 127 127 zdta(:,:,:,jn) = 0.0 … … 142 142 cltra = TRIM(seddia3d(jn)) 143 143 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 144 CALL iom_get( numrsr, jpdom_auto glo, TRIM(cltra), zdta1(:,:,:,jn) )144 CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta1(:,:,:,jn) ) 145 145 ELSE 146 146 zdta1(:,:,:,jn) = 0.0 … … 169 169 cltra = "dbioturb" 170 170 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 171 CALL iom_get( numrsr, jpdom_auto glo, TRIM(cltra), zdta2(:,:,:) )171 CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 172 172 ELSE 173 173 zdta2(:,:,:) = 0.0 … … 179 179 cltra = "irrig" 180 180 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 181 CALL iom_get( numrsr, jpdom_auto glo, TRIM(cltra), zdta2(:,:,:) )181 CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 182 182 ELSE 183 183 zdta2(:,:,:) = 0.0 … … 189 189 cltra = "sedligand" 190 190 IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 191 CALL iom_get( numrsr, jpdom_auto glo, TRIM(cltra), zdta2(:,:,:) )191 CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 192 192 ELSE 193 193 zdta2(:,:,:) = 0.0 -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/SED/sedsfc.F90
r12377 r13899 48 48 49 49 50 DO_2D _11_1150 DO_2D( 1, 1, 1, 1 ) 51 51 ikt = mbkt(ji,jj) 52 52 IF ( tmask(ji,jj,ikt) == 1 ) THEN -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/SED/trcdmp_sed.F90
r12377 r13899 21 21 USE trc ! ocean passive tracers variables 22 22 USE trcdta 23 USE prtctl _trc! Print control for debbuging23 USE prtctl ! Print control for debbuging 24 24 USE iom 25 25 … … 93 93 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 94 94 ! 95 DO_2D _11_1195 DO_2D( 1, 1, 1, 1 ) 96 96 ikt = mbkt(ji,jj) 97 97 tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) - ztrcdta(ji,jj,ikt) ) & … … 107 107 IF( sn_cfctl%l_prttrc ) THEN 108 108 WRITE(charout, FMT="('dmp ')") 109 CALL prt_ctl_ trc_info(charout)110 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )109 CALL prt_ctl_info( charout, cdcomp = 'top' ) 110 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 111 111 ENDIF 112 112 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/trcwri_pisces.F90
r13237 r13899 69 69 zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 70 70 zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1) 71 DO_3D _11_11(2, jpkm1 )71 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 72 72 IF( tmask(ji,jj,jk) == 1 ) then 73 73 IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcadv.F90
r13237 r13899 29 29 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 30 30 ! 31 USE prtctl _trc! control print31 USE prtctl ! control print 32 32 USE timing ! Timing 33 33 … … 138 138 IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging) 139 139 WRITE(charout, FMT="('adv ')") 140 CALL prt_ctl_ trc_info(charout)141 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )140 CALL prt_ctl_info( charout, cdcomp = 'top' ) 141 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 142 142 END IF 143 143 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcatf.F90
r13237 r13899 43 43 ! 44 44 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 45 USE prtctl _trc! Print control for debbuging45 USE prtctl ! Print control for debbuging 46 46 47 47 IMPLICIT NONE … … 184 184 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 185 185 WRITE(charout, FMT="('nxt')") 186 CALL prt_ctl_ trc_info(charout)187 CALL prt_ctl _trc(tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm)186 CALL prt_ctl_info( charout, cdcomp = 'top' ) 187 CALL prt_ctl(tab4d_1=ptr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm) 188 188 ENDIF 189 189 ! … … 239 239 ! 240 240 DO jn = 1, jptra 241 DO_3D _11_11(1, jpkm1 )241 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 242 242 ze3t_b = e3t(ji,jj,jk,Kbb) 243 243 ze3t_n = e3t(ji,jj,jk,Kmm) … … 314 314 ! 315 315 DO jn = 1, jptra 316 DO_3D _11_11(1, jpkm1 )316 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 317 317 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 318 318 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcbbl.F90
r12377 r13899 25 25 USE trdtra ! tracer trends 26 26 USE trabbl ! bottom boundary layer 27 USE prtctl _trc! Print control for debbuging27 USE prtctl ! Print control for debbuging 28 28 29 29 PUBLIC trc_bbl ! routine called by trctrp.F90 … … 70 70 CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 71 71 IF( sn_cfctl%l_prttrc ) THEN 72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_ trc_info(charout)73 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )72 WRITE(charout, FMT="(' bbl_dif')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 73 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 74 74 ENDIF 75 75 ! … … 81 81 CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 82 82 IF( sn_cfctl%l_prttrc ) THEN 83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_ trc_info(charout)84 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )83 WRITE(charout, FMT="(' bbl_adv')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 84 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 85 85 ENDIF 86 86 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcdmp.F90
r13237 r13899 24 24 ! 25 25 USE iom 26 USE prtctl _trc! Print control for debbuging26 USE prtctl ! Print control for debbuging 27 27 28 28 IMPLICIT NONE … … 113 113 ! 114 114 CASE( 0 ) !== newtonian damping throughout the water column ==! 115 DO_3D _00_00(1, jpkm1 )115 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 116 116 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) 117 117 END_3D 118 118 ! 119 119 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 120 DO_3D _00_00(1, jpkm1 )120 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 121 121 IF( avt(ji,jj,jk) <= avt_c ) THEN 122 122 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) … … 125 125 ! 126 126 CASE ( 2 ) !== no damping in the mixed layer ==! 127 DO_3D _00_00(1, jpkm1 )127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 128 128 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 129 129 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - ptr(ji,jj,jk,jn,Kbb) ) … … 149 149 IF( sn_cfctl%l_prttrc ) THEN 150 150 WRITE(charout, FMT="('dmp ')") 151 CALL prt_ctl_ trc_info(charout)152 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )151 CALL prt_ctl_info( charout, cdcomp = 'top' ) 152 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 153 153 ENDIF 154 154 ! … … 205 205 !Read in mask from file 206 206 CALL iom_open ( cn_resto_tr, imask) 207 CALL iom_get ( imask, jpdom_auto glo, 'resto', restotr)207 CALL iom_get ( imask, jpdom_auto, 'resto', restotr) 208 208 CALL iom_close( imask ) 209 209 ! … … 246 246 ! ! ======================= 247 247 CASE ( 1 ) ! eORCA_R1 configuration 248 ! ! ======================= 249 isrow = 332 - jpjglo 250 ! 251 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 252 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 253 ! 254 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 255 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 256 ! 257 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 258 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 259 ! 260 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 261 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 262 ! 263 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 264 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 265 ! 266 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 267 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 268 ! 269 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 270 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 271 ! 272 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 273 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 274 ! 275 ! ! ======================= 248 ! ! ======================= 249 ! 250 isrow = 332 - (Nj0glo + 1) ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1 251 ! 252 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow ! Caspian Sea 253 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 254 ! 255 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow ! Lake Superior 256 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 257 ! 258 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow ! Lake Michigan 259 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 260 ! 261 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow ! Lake Huron 262 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 263 ! 264 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow ! Lake Erie 265 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 266 ! 267 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow ! Lake Ontario 268 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 269 ! 270 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow ! Victoria Lake 271 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 272 ! 273 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow ! Baltic Sea 274 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 275 ! 276 ! ! ======================= 276 277 CASE ( 2 ) ! ORCA_R2 configuration 277 278 ! ! ======================= … … 286 287 nctsi2(3) = 181 ; nctsj2(3) = 112 287 288 ! 288 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea289 nctsi1(4) = 2 ; nctsj1(4) = 107 ! Black Sea 2 : est part of the Black Sea 289 290 nctsi2(4) = 6 ; nctsj2(4) = 112 290 291 ! 291 292 nctsi1(5) = 145 ; nctsj1(5) = 116 ! Baltic Sea 292 293 nctsi2(5) = 150 ; nctsj2(5) = 126 294 ! 293 295 ! ! ======================= 294 296 CASE ( 4 ) ! ORCA_R4 configuration … … 306 308 nctsi1(4) = 75 ; nctsj1(4) = 59 ! Baltic Sea 307 309 nctsi2(4) = 76 ; nctsj2(4) = 61 310 ! 308 311 ! ! ======================= 309 312 CASE ( 025 ) ! ORCA_R025 configuration … … 319 322 ! 320 323 ENDIF 324 ! 325 nctsi1(:) = nctsi1(:) + nn_hls - 1 ; nctsi2(:) = nctsi2(:) + nn_hls - 1 ! -1 as x-perio included in old input files 326 nctsj1(:) = nctsj1(:) + nn_hls ; nctsj2(:) = nctsj2(:) + nn_hls 321 327 ! 322 328 ! convert the position in local domain indices -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcldf.F90
r13237 r13899 25 25 USE trdtra ! trends manager: tracers 26 26 ! 27 USE prtctl _trc! Print control27 USE prtctl ! Print control 28 28 29 29 IMPLICIT NONE … … 82 82 zahv(:,:,:) = rldf * ahtv(:,:,:) 83 83 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 84 DO_3D _11_11(1, jpk )84 DO_3D( 1, 1, 1, 1, 1, jpk ) 85 85 IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 86 86 zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. … … 115 115 IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 116 116 WRITE(charout, FMT="('ldf ')") 117 CALL prt_ctl_ trc_info(charout)118 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )117 CALL prt_ctl_info( charout, cdcomp = 'top' ) 118 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 119 119 ENDIF 120 120 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcrad.F90
r12489 r13899 19 19 USE trd_oce 20 20 USE trdtra 21 USE prtctl _trc! Print control for debbuging21 USE prtctl ! Print control for debbuging 22 22 USE lib_fortran 23 23 … … 72 72 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 73 73 WRITE(charout, FMT="('rad')") 74 CALL prt_ctl_ trc_info( charout)75 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm )74 CALL prt_ctl_info( charout, cdcomp = 'top' ) 75 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm ) 76 76 ENDIF 77 77 ! … … 168 168 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,itime) ! save input tr(:,:,:,:,Kbb) for trend computation 169 169 ! 170 DO_3D _11_11(1, jpkm1 )170 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 171 171 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 172 172 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcsbc.F90
r13237 r13899 18 18 USE oce_trc ! ocean dynamics and active tracers variables 19 19 USE trc ! ocean passive tracers variables 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 USE iom 22 22 USE trd_oce … … 88 88 zfact = 0.5_wp 89 89 DO jn = 1, jptra 90 CALL iom_get( numrtr, jpdom_auto glo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc90 CALL iom_get( numrtr, jpdom_auto, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 91 91 END DO 92 92 ELSE ! No restart or restart not found: Euler forward time stepping … … 121 121 ! 122 122 DO jn = 1, jptra 123 DO_2D _01_00123 DO_2D( 0, 1, 0, 0 ) 124 124 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 125 125 END_2D … … 129 129 ! 130 130 DO jn = 1, jptra 131 DO_2D _01_00131 DO_2D( 0, 1, 0, 0 ) 132 132 sbc_trc(ji,jj,jn) = ( zsfx(ji,jj) + fmmflx(ji,jj) ) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) 133 133 END_2D … … 137 137 ! 138 138 DO jn = 1, jptra 139 DO_2D _01_00139 DO_2D( 0, 1, 0, 0 ) 140 140 zse3t = 1. / e3t(ji,jj,1,Kmm) 141 141 ! tracer flux at the ice/ocean interface (tracer/m2/s) … … 161 161 IF( l_trdtrc ) ztrtrd(:,:,:) = ptr(:,:,:,jn,Krhs) ! save trends 162 162 ! 163 DO_2D _01_00163 DO_2D( 0, 1, 0, 0 ) 164 164 zse3t = zfact / e3t(ji,jj,1,Kmm) 165 165 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t … … 187 187 ! 188 188 IF( sn_cfctl%l_prttrc ) THEN 189 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_ trc_info(charout)190 CALL prt_ctl _trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )189 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_info( charout, cdcomp = 'top' ) 190 CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 191 191 ENDIF 192 192 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trcsink.F90
r13237 r13899 74 74 iiter(:,:) = 1 75 75 ELSE 76 DO_2D _11_1176 DO_2D( 1, 1, 1, 1 ) 77 77 iiter(ji,jj) = 1 78 78 DO jk = 1, jpkm1 … … 86 86 ENDIF 87 87 88 DO_3D _11_11(1,jpkm1 )88 DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 89 89 IF( tmask(ji,jj,jk) == 1.0 ) THEN 90 90 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact … … 146 146 DO jn = 1, 2 147 147 ! first guess of the slopes interior values 148 DO_2D _11_11148 DO_2D( 1, 1, 1, 1 ) 149 149 ! 150 150 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. … … 186 186 END DO 187 187 188 DO_3D _11_11(1,jpkm1 )188 DO_3D( 1, 1, 1, 1, 1,jpkm1 ) 189 189 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 190 190 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trczdf.F90
r12489 r13899 22 22 !!gm 23 23 USE trdtra ! trends manager: tracers 24 USE prtctl _trc! Print control24 USE prtctl ! Print control 25 25 26 26 IMPLICIT NONE … … 69 69 IF( sn_cfctl%l_prttrc ) THEN 70 70 WRITE(charout, FMT="('zdf ')") 71 CALL prt_ctl_ trc_info(charout)72 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )71 CALL prt_ctl_info( charout, cdcomp = 'top' ) 72 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 73 73 END IF 74 74 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trdmxl_trc.F90
r13237 r13899 125 125 126 126 IF( jpktrd_trc < jpk ) THEN ! description ??? 127 DO_2D _11_11127 DO_2D( 1, 1, 1, 1 ) 128 128 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 129 129 zvlmsk(ji,jj) = tmask(ji,jj,1) … … 148 148 ! ... Weights for vertical averaging 149 149 wkx_trc(:,:,:) = 0.e0 150 DO_3D _11_11( 1, jpktrd_trc )150 DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) ! initialize wkx_trc with vertical scale factor in mixed-layer 151 151 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 152 152 END_3D … … 259 259 ! 260 260 DO jn = 1, jptra 261 DO_2D _11_11261 DO_2D( 1, 1, 1, 1 ) 262 262 ik = nmld_trc(ji,jj) 263 263 IF( ln_trdtrc(jn) ) & -
NEMO/branches/2020/tickets_icb_1900/src/TOP/TRP/trdmxl_trc_rst.F90
r12377 r13899 144 144 145 145 DO jn = 1, jptra 146 CALL iom_get( inum, jpdom_auto glo, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) )147 CALL iom_get( inum, jpdom_auto glo, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) )148 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) )149 CALL iom_get( inum, jpdom_auto glo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) )146 CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) ) 147 CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) 148 CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 149 CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 150 150 END DO 151 151 152 152 ELSE 153 CALL iom_get( inum, jpdom_auto glo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum153 CALL iom_get( inum, jpdom_auto, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 154 154 155 155 ! ! =========== 156 156 DO jn = 1, jptra ! tracer loop 157 157 ! ! =========== 158 CALL iom_get( inum, jpdom_auto glo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) )159 CALL iom_get( inum, jpdom_auto glo, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) )160 CALL iom_get( inum, jpdom_auto glo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) )161 162 CALL iom_get( inum, jpdom_auto glo, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) ! needed for tml_sum163 CALL iom_get( inum, jpdom_auto glo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) )158 CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 159 CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_' //ctrcnm(jn), tmlbb_trc (:,:,jn) ) 160 CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 161 162 CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_' //ctrcnm(jn), tmlbn_trc (:,:,jn) ) ! needed for tml_sum 163 CALL iom_get( inum, jpdom_auto, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 164 164 165 165 DO jk = 1, jpltrd_trc … … 169 169 WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk 170 170 ENDIF 171 CALL iom_get( inum, jpdom_auto glo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) )171 CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 172 172 END DO 173 173 174 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , &174 CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 175 175 & tmltrd_atf_sumb_trc(:,:,jn) ) 176 176 177 CALL iom_get( inum, jpdom_auto glo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , &177 CALL iom_get( inum, jpdom_auto, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 178 178 & tmltrd_rad_sumb_trc(:,:,jn) ) 179 179 ! ! =========== -
NEMO/branches/2020/tickets_icb_1900/src/TOP/oce_trc.F90
r12489 r13899 18 18 USE par_oce , ONLY : jp_tem => jp_tem !: indice for temperature 19 19 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 20 USE par_oce , ONLY : nn_hls => nn_hls !: 21 USE par_oce , ONLY : Nis0 => Nis0 !: 22 USE par_oce , ONLY : Njs0 => Njs0 !: 23 USE par_oce , ONLY : Nie0 => Nie0 !: 24 USE par_oce , ONLY : Nje0 => Nje0 !: 25 USE par_oce , ONLY : Nis1 => Nis1 !: 26 USE par_oce , ONLY : Njs1 => Njs1 !: 27 USE par_oce , ONLY : Nie1 => Nie1 !: 28 USE par_oce , ONLY : Nje1 => Nje1 !: 29 USE par_oce , ONLY : Nis1nxt2 => Nis1nxt2 !: 30 USE par_oce , ONLY : Njs1nxt2 => Njs1nxt2 !: 31 USE par_oce , ONLY : Nie1nxt2 => Nie1nxt2 !: 32 USE par_oce , ONLY : Nje1nxt2 => Nje1nxt2 !: 33 USE par_oce , ONLY : Nis2 => Nis2 !: 34 USE par_oce , ONLY : Njs2 => Njs2 !: 35 USE par_oce , ONLY : Nie2 => Nie2 !: 36 USE par_oce , ONLY : Nje2 => Nje2 !: 37 USE par_oce , ONLY : Ni_0 => Ni_0 !: 38 USE par_oce , ONLY : Nj_0 => Nj_0 !: 39 USE par_oce , ONLY : Ni_1 => Ni_1 !: 40 USE par_oce , ONLY : Nj_1 => Nj_1 !: 41 USE par_oce , ONLY : Ni_2 => Ni_2 !: 42 USE par_oce , ONLY : Nj_2 => Nj_2 !: 20 43 21 44 USE in_out_manager !* IO manager * … … 62 85 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface 63 86 USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction 87 USE traqsr , ONLY : nksr => nksr !: levels below which the light cannot penetrate (depth larger than 391 m) 88 USE traqsr , ONLY : rkrgb => rkrgb !: tabulated attenuation coefficients for RGB absorption 64 89 USE traqsr , ONLY : ln_qsr_bio => ln_qsr_bio !: flag to use or not the biological fluxes for light 65 90 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trc.F90
r12489 r13899 21 21 INTEGER, PUBLIC :: numonr = -1 !: reference passive tracer namelist output output.namelist.top 22 22 INTEGER, PUBLIC :: numstr !: tracer statistics 23 INTEGER, PUBLIC :: numrtr 23 INTEGER, PUBLIC :: numrtr = -1 !: trc restart (read ) 24 24 INTEGER, PUBLIC :: numrtw !: trc restart ( write ) 25 25 CHARACTER(:), ALLOCATABLE, PUBLIC :: numnat_ref !: character buffer for reference passive tracer namelist_top_ref -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcbc.F90
r13237 r13899 415 415 ! Remove river dilution for tracers with absent river load 416 416 IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN 417 DO_2D _01_00417 DO_2D( 0, 1, 0, 0 ) 418 418 DO jk = 1, nk_rnf(ji,jj) 419 419 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj) … … 429 429 jl = n_trc_indsbc(jn) 430 430 sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation 431 DO_2D _01_00431 DO_2D( 0, 1, 0, 0 ) 432 432 zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time ) 433 433 ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact … … 439 439 IF( l_offline ) rn_rfact = 1._wp 440 440 jl = n_trc_indcbc(jn) 441 DO_2D _01_00441 DO_2D( 0, 1, 0, 0 ) 442 442 DO jk = 1, nk_rnf(ji,jj) 443 443 zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcbdy.F90
r13226 r13899 49 49 INTEGER :: ib_bdy ,ir, jn ,igrd ! Loop indices 50 50 REAL(wp), POINTER, DIMENSION(:,:) :: ztrc 51 REAL(wp), POINTER :: zfac52 51 LOGICAL :: llrim0 ! indicate if rim 0 is treated 53 52 LOGICAL, DIMENSION(4) :: llsend1, llrecv1 ! indicate how communications are to be carried out … … 61 60 IF( ir == 0 ) THEN ; llrim0 = .TRUE. 62 61 ELSE ; llrim0 = .FALSE. 63 END 62 ENDIF 64 63 DO ib_bdy=1, nb_bdy 64 ! 65 65 DO jn = 1, jptra 66 66 ! 67 ztrc => trcdta_bdy(jn,ib_bdy)%trc 68 zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 67 IF( ASSOCIATED(trcdta_bdy(jn,ib_bdy)%trc) .AND. trcdta_bdy(jn,ib_bdy)%cn_obc /= 'neumann' ) THEN 68 IF( .NOT. ASSOCIATED(ztrc) ) ALLOCATE( ztrc(idx_bdy(ib_bdy)%nblen(igrd),jpk) ) 69 ztrc(:,:) = trcdta_bdy(jn,ib_bdy)%trc(:,:) * trcdta_bdy(jn,ib_bdy)%rn_fac 70 ENDIF 69 71 ! 70 SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc))72 SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 71 73 CASE('none' ) ; CYCLE 72 74 CASE('frs' ) ! treat the whole boundary at once 73 IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy), tr(:,:,:,jn,Krhs), ztrc*zfac )75 IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy), tr(:,:,:,jn,Krhs), ztrc ) 74 76 CASE('specified' ) ! treat the whole rim at once 75 IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy), tr(:,:,:,jn,Krhs), ztrc*zfac ) 76 CASE('neumann' ) ; CALL bdy_nmn( idx_bdy(ib_bdy), igrd , tr(:,:,:,jn,Krhs) ) ! tra masked 77 CASE('orlanski' ) ; CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. ) 78 CASE('orlanski_npo') ; CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. ) 77 IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy), tr(:,:,:,jn,Krhs), ztrc ) 78 CASE('neumann' ) ; CALL bdy_nmn( idx_bdy(ib_bdy), igrd , tr(:,:,:,jn,Krhs), llrim0 ) ! tra masked 79 CASE('orlanski' ) ; CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0, & 80 & ll_npo=.FALSE. ) 81 CASE('orlanski_npo') ; CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0, & 82 & ll_npo=.TRUE. ) 79 83 CASE DEFAULT ; CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 80 84 END SELECT 81 85 ! 82 86 END DO 87 ! 88 IF( ASSOCIATED(ztrc) ) DEALLOCATE(ztrc) 89 ! 83 90 END DO 84 91 ! 85 92 IF( nn_hls > 1 .AND. ir == 1 ) CYCLE ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 86 IF( nn_hls == 1 ) THEN ; llsend1(:) = .false. ; llrecv1(:) = .false. ; END 93 IF( nn_hls == 1 ) THEN ; llsend1(:) = .false. ; llrecv1(:) = .false. ; ENDIF 87 94 DO ib_bdy=1, nb_bdy 88 SELECT CASE( TRIM(cn_tra(ib_bdy)) )95 SELECT CASE( cn_tra(ib_bdy) ) 89 96 CASE('neumann') 90 97 llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir) ! possibly every direction, T points … … 97 104 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 98 105 CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 99 END 106 ENDIF 100 107 ! 101 108 END DO ! ir -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcdta.F90
r13237 r13899 199 199 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 200 200 ENDIF 201 DO_2D _11_11201 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 202 202 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 203 203 zl = gdept(ji,jj,jk,Kmm) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcini.F90
r13237 r13899 20 20 USE trcnam ! Namelist read 21 21 USE daymod ! calendar manager 22 USE prtctl _trc ! Print control passive tracers (prt_ctl_trc_init routine)22 USE prtctl ! Print control passive tracers (prt_ctl_init routine) 23 23 USE trcrst 24 24 USE lib_mpp ! distribued memory computing library … … 94 94 INTEGER :: jk, jn ! dummy loop indices 95 95 CHARACTER (len=25) :: charout 96 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk 97 CHARACTER (len=25), DIMENSION(jptra) :: clseb 96 98 !!---------------------------------------------------------------------- 97 99 ! … … 125 127 IF(lwp) WRITE(numout,*) 126 128 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 127 CALL prt_ctl_ trc_init129 CALL prt_ctl_init( 'top', jptra ) 128 130 WRITE(charout, FMT="('ini ')") 129 CALL prt_ctl_trc_info( charout ) 130 CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 131 CALL prt_ctl_info( charout, cdcomp = 'top' ) 132 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 133 DO jn = 1, jptra 134 zzmsk(:,:,:,jn) = tmask(:,:,:) 135 WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 136 END DO 137 CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb ) 131 138 ENDIF 132 139 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcrst.F90
r13237 r13899 114 114 ! READ prognostic variables and computes diagnostic variable 115 115 DO jn = 1, jptra 116 CALL iom_get( numrtr, jpdom_auto glo, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )117 END DO 118 119 DO jn = 1, jptra 120 CALL iom_get( numrtr, jpdom_auto glo, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )116 CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 117 END DO 118 119 DO jn = 1, jptra 120 CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 121 121 END DO 122 122 ! … … 237 237 ! calculate start time in hours and minutes 238 238 zdayfrac=adatrj-INT(adatrj) 239 ksecs = NINT(zdayfrac*86400) ! Nearest second to catch rounding errors in adatrj 239 ksecs = NINT(zdayfrac*86400) ! Nearest second to catch rounding errors in adatrj 240 240 ihour = INT(ksecs/3600) 241 241 iminute = ksecs/60-ihour*60 … … 258 258 adatrj = INT(adatrj) ! adatrj set to integer as nn_time0 updated 259 259 ELSE 260 ndt05 = NINT( 0.5 * rn_Dt ) ! --- WARNING --- not defined yet are we did not go through day_init 260 261 ! parameters corresponding to nit000 - 1 (as we start the step 261 262 ! loop with a call to day) 262 ndastp = ndate0 - 1! ndate0 read in the namelist in dom_nam263 ndastp = ndate0 ! ndate0 read in the namelist in dom_nam 263 264 nhour = nn_time0 / 100 264 265 nminute = ( nn_time0 - nhour * 100 ) -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcsms.F90
r12377 r13899 20 20 USE trcsms_age ! AGE 21 21 USE trcsms_my_trc ! MY_TRC tracers 22 USE prtctl _trc! Print control for debbuging22 USE prtctl ! Print control for debbuging 23 23 24 24 IMPLICIT NONE … … 58 58 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 59 59 WRITE(charout, FMT="('sms ')") 60 CALL prt_ctl_ trc_info( charout)61 CALL prt_ctl _trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )60 CALL prt_ctl_info( charout, cdcomp = 'top' ) 61 CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 62 62 ENDIF 63 63 ! -
NEMO/branches/2020/tickets_icb_1900/src/TOP/trcstp.F90
r13237 r13899 22 22 USE sms_pisces, ONLY : ln_check_mass 23 23 ! 24 USE prtctl _trc! Print control for debbuging24 USE prtctl ! Print control for debbuging 25 25 USE iom ! 26 26 USE in_out_manager ! … … 92 92 IF(sn_cfctl%l_prttrc) THEN 93 93 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 94 CALL prt_ctl_ trc_info(charout)94 CALL prt_ctl_info( charout, cdcomp = 'top' ) 95 95 ENDIF 96 96 ! … … 200 200 rsecfst = INT( zkt ) * rn_Dt 201 201 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 202 CALL iom_get( numrtr, jpdom_auto glo, 'qsr_mean', qsr_mean ) ! A mean of qsr202 CALL iom_get( numrtr, jpdom_auto, 'qsr_mean', qsr_mean ) ! A mean of qsr 203 203 CALL iom_get( numrtr, 'nrdcy', zrec ) ! Number of record per days 204 204 IF( INT( zrec ) == nb_rec_per_day ) THEN … … 206 206 IF( jn <= 9 ) THEN 207 207 WRITE(cl1,'(i1)') jn 208 CALL iom_get( numrtr, jpdom_auto glo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr208 CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr 209 209 ELSE 210 210 WRITE(cl2,'(i2.2)') jn 211 CALL iom_get( numrtr, jpdom_auto glo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr211 CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr 212 212 ENDIF 213 213 END DO
Note: See TracChangeset
for help on using the changeset viewer.