Changeset 13295 for NEMO/trunk/src/OCE
- Timestamp:
- 2020-07-10T20:24:21+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE
- Files:
-
- 116 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/ASM/asminc.F90
r13286 r13295 414 414 DO jk = 1, jpkm1 ! zhdiv = e1e1 * div 415 415 zhdiv(:,:) = 0._wp 416 DO_2D _00_00416 DO_2D( 0, 0, 0, 0 ) 417 417 zhdiv(ji,jj) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * u_bkginc(ji ,jj,jk) & 418 418 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * u_bkginc(ji-1,jj,jk) & … … 423 423 CALL lbc_lnk( 'asminc', zhdiv, 'T', 1.0_wp ) ! lateral boundary cond. (no sign change) 424 424 ! 425 DO_2D _00_00425 DO_2D( 0, 0, 0, 0 ) 426 426 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) & 427 427 & + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) -
NEMO/trunk/src/OCE/C1D/dtauvd.F90
r12377 r13295 158 158 ENDIF 159 159 ! 160 DO_2D _11_11160 DO_2D( 1, 1, 1, 1 ) 161 161 DO jk = 1, jpk 162 162 zl = gdept(ji,jj,jk,Kmm) … … 193 193 ! 194 194 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 195 DO_2D _11_11195 DO_2D( 1, 1, 1, 1 ) 196 196 ik = mbkt(ji,jj) 197 197 IF( ik > 1 ) THEN -
NEMO/trunk/src/OCE/C1D/dyncor_c1d.F90
r12377 r13295 77 77 ! 78 78 IF( ln_stcor ) THEN 79 DO_3D _00_00(1, jpkm1 )79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 80 80 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ff_t(ji,jj) * (pvv(ji,jj,jk,Kmm) + vsd(ji,jj,jk)) 81 81 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ff_t(ji,jj) * (puu(ji,jj,jk,Kmm) + usd(ji,jj,jk)) 82 82 END_3D 83 83 ELSE 84 DO_3D _00_00(1, jpkm1 )84 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 85 85 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ff_t(ji,jj) * pvv(ji,jj,jk,Kmm) 86 86 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ff_t(ji,jj) * puu(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/C1D/dyndmp.F90
r13286 r13295 165 165 ! 166 166 CASE( 0 ) ! Newtonian damping throughout the water column 167 DO_3D _00_00(1, jpkm1 )167 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 168 168 zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) ) 169 169 zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) ) … … 175 175 ! 176 176 CASE ( 1 ) ! no damping above the turbocline (avt > 5 cm2/s) 177 DO_3D _00_00(1, jpkm1 )177 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 178 178 IF( avt(ji,jj,jk) <= avt_c ) THEN 179 179 zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) ) … … 190 190 ! 191 191 CASE ( 2 ) ! no damping in the mixed layer 192 DO_3D _00_00(1, jpkm1 )192 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 193 193 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 194 194 zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) ) -
NEMO/trunk/src/OCE/CRS/crsfld.F90
r13237 r13295 120 120 ! 121 121 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 122 DO_3D _00_00(1, jpkm1 )122 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 123 123 zt(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 124 124 zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) … … 135 135 ! 136 136 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 137 DO_3D _00_00(1, jpkm1 )137 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 138 138 zt(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 139 139 zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) … … 148 148 IF( iom_use( "eken") ) THEN ! kinetic energy 149 149 z3d(:,:,jk) = 0._wp 150 DO_3D _00_00(1, jpkm1 )150 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 151 151 zztmp = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 152 152 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & -
NEMO/trunk/src/OCE/DIA/diaar5.F90
r13286 r13295 110 110 ! 111 111 IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 ikb = mbkt(ji,jj) 114 114 z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) … … 195 195 ! ! Mean density anomalie, temperature and salinity 196 196 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 197 DO_3D _11_11(1, jpkm1 )197 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 198 198 zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 199 199 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) … … 255 255 IF( iom_use( 'tosmint_pot') ) THEN 256 256 z2d(:,:) = 0._wp 257 DO_3D _11_11(1, jpkm1 )257 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 258 258 z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ztpot(ji,jj,jk) 259 259 END_3D … … 276 276 zpe(:,:) = 0._wp 277 277 IF( ln_zdfddm ) THEN 278 DO_3D _11_11(2, jpk )278 DO_3D( 1, 1, 1, 1, 2, jpk ) 279 279 IF( rn2(ji,jj,jk) > 0._wp ) THEN 280 280 zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) … … 289 289 END_3D 290 290 ELSE 291 DO_3D _11_11(1, jpk )291 DO_3D( 1, 1, 1, 1, 1, jpk ) 292 292 zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm) 293 293 END_3D … … 324 324 325 325 z2d(:,:) = puflx(:,:,1) 326 DO_3D _00_00(1, jpkm1 )326 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 327 327 z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk) 328 328 END_3D … … 338 338 ! 339 339 z2d(:,:) = pvflx(:,:,1) 340 DO_3D _00_00(1, jpkm1 )340 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 341 341 z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk) 342 342 END_3D … … 385 385 zvol0 (:,:) = 0._wp 386 386 thick0(:,:) = 0._wp 387 DO_3D _11_11(1, jpkm1 )387 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 388 388 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 389 389 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * e1e2t(ji,jj) … … 403 403 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 404 404 IF( ln_zps ) THEN ! z-coord. partial steps 405 DO_2D _11_11405 DO_2D( 1, 1, 1, 1 ) 406 406 ik = mbkt(ji,jj) 407 407 IF( ik > 1 ) THEN -
NEMO/trunk/src/OCE/DIA/diacfl.F90
r13237 r13295 60 60 IF( ln_timing ) CALL timing_start('dia_cfl') 61 61 ! 62 DO_3D _11_11(1, jpk )62 DO_3D( 1, 1, 1, 1, 1, jpk ) 63 63 zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u (ji,jj) ! for i-direction 64 64 zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * rDt / e2v (ji,jj) ! for j-direction -
NEMO/trunk/src/OCE/DIA/diahth.F90
r13237 r13295 130 130 zdepinv(:,:) = 0._wp 131 131 zmaxdzT(:,:) = 0._wp 132 DO_2D _11_11132 DO_2D( 1, 1, 1, 1 ) 133 133 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 134 134 hth (ji,jj) = zztmp … … 139 139 END_2D 140 140 IF( nla10 > 1 ) THEN 141 DO_2D _11_11141 DO_2D( 1, 1, 1, 1 ) 142 142 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 143 143 zrho0_3(ji,jj) = zztmp … … 148 148 ! Preliminary computation 149 149 ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) 150 DO_2D _11_11150 DO_2D( 1, 1, 1, 1 ) 151 151 IF( tmask(ji,jj,nla10) == 1. ) THEN 152 152 zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & … … 170 170 ! MLD: rho = rho(1) + zrho1 ! 171 171 ! ------------------------------------------------------------- ! 172 DO_3DS _11_11(jpkm1, 2, -1 )172 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 173 173 ! 174 174 zzdep = gdepw(ji,jj,jk,Kmm) … … 207 207 ! depth of temperature inversion ! 208 208 ! ------------------------------------------------------------- ! 209 DO_3DS _11_11(jpkm1, nlb10, -1 )209 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 210 210 ! 211 211 zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) … … 305 305 ! --------------------------------------- ! 306 306 iktem(:,:) = 1 307 DO_3D _11_11(1, jpkm1 )307 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 308 308 zztmp = ts(ji,jj,jk,jp_tem,Kmm) 309 309 IF( zztmp >= ptem ) iktem(ji,jj) = jk … … 313 313 ! Depth of ptem isotherm ! 314 314 ! ------------------------------- ! 315 DO_2D _11_11315 DO_2D( 1, 1, 1, 1 ) 316 316 ! 317 317 zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom … … 351 351 ! 352 352 ilevel(:,:) = 1 353 DO_3D _11_11(2, jpkm1 )353 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 354 354 IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 355 355 ilevel(ji,jj) = jk … … 359 359 END_3D 360 360 ! 361 DO_2D _11_11361 DO_2D( 1, 1, 1, 1 ) 362 362 ik = ilevel(ji,jj) 363 363 zthick(ji,jj) = pdep - zthick(ji,jj) ! remaining thickness to reach depht pdep -
NEMO/trunk/src/OCE/DIA/diaptr.F90
r13286 r13295 119 119 zmask(:,:,:) = 0._wp 120 120 zts(:,:,:,:) = 0._wp 121 DO_3D _10_11(1, jpkm1 )121 DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 122 122 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 123 123 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc … … 190 190 zts(:,:,:,:) = 0._wp 191 191 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 192 DO_3D _11_11(1, jpkm1 )192 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 193 193 zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 194 194 zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc … … 280 280 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 281 281 zts(:,:,:,:) = 0._wp 282 DO_3D _10_11(1, jpkm1 )282 DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 283 283 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 284 284 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid … … 505 505 ijpj = jpj 506 506 p_fval(:) = 0._wp 507 DO_3D _00_00(1, jpkm1 )507 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 508 508 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 509 509 END_3D … … 538 538 ijpj = jpj 539 539 p_fval(:) = 0._wp 540 DO_2D _00_00540 DO_2D( 0, 0, 0, 0 ) 541 541 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 542 542 END_2D … … 567 567 p_fval(:,:) = 0._wp 568 568 DO jc = 1, jpnj ! looping over all processors in j axis 569 DO_2D _00_00569 DO_2D( 0, 0, 0, 0 ) 570 570 p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 571 571 END_2D … … 606 606 p_fval(:,:) = 0._wp 607 607 ! 608 DO_3D _00_00(1, jpkm1 )608 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 609 609 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 610 610 END_3D -
NEMO/trunk/src/OCE/DIA/diawri.F90
r13286 r13295 175 175 CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 176 176 IF ( iom_use("sbt") ) THEN 177 DO_2D _11_11177 DO_2D( 1, 1, 1, 1 ) 178 178 ikbot = mbkt(ji,jj) 179 179 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) … … 185 185 CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity 186 186 IF ( iom_use("sbs") ) THEN 187 DO_2D _11_11187 DO_2D( 1, 1, 1, 1 ) 188 188 ikbot = mbkt(ji,jj) 189 189 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) … … 199 199 zztmp = rho0 * 0.25 200 200 z2d(:,:) = 0._wp 201 DO_2D _00_00201 DO_2D( 0, 0, 0, 0 ) 202 202 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 203 203 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & … … 214 214 CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current 215 215 IF ( iom_use("sbu") ) THEN 216 DO_2D _11_11216 DO_2D( 1, 1, 1, 1 ) 217 217 ikbot = mbku(ji,jj) 218 218 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) … … 224 224 CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current 225 225 IF ( iom_use("sbv") ) THEN 226 DO_2D _11_11226 DO_2D( 1, 1, 1, 1 ) 227 227 ikbot = mbkv(ji,jj) 228 228 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) … … 254 254 255 255 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 256 DO_2D _00_00256 DO_2D( 0, 0, 0, 0 ) 257 257 zztmp = ts(ji,jj,1,jp_tem,Kmm) 258 258 zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) … … 270 270 IF( iom_use("heatc") ) THEN 271 271 z2d(:,:) = 0._wp 272 DO_3D _11_11(1, jpkm1 )272 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 273 273 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 274 274 END_3D … … 278 278 IF( iom_use("saltc") ) THEN 279 279 z2d(:,:) = 0._wp 280 DO_3D _11_11(1, jpkm1 )280 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 281 281 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 282 282 END_3D … … 286 286 IF ( iom_use("eken") ) THEN 287 287 z3d(:,:,jpk) = 0._wp 288 DO_3D _00_00(1, jpkm1 )288 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 289 289 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 290 290 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & … … 312 312 IF( iom_use("u_heattr") ) THEN 313 313 z2d(:,:) = 0._wp 314 DO_3D _00_00(1, jpkm1 )314 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 315 315 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 316 316 END_3D … … 321 321 IF( iom_use("u_salttr") ) THEN 322 322 z2d(:,:) = 0.e0 323 DO_3D _00_00(1, jpkm1 )323 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 324 324 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 325 325 END_3D … … 339 339 IF( iom_use("v_heattr") ) THEN 340 340 z2d(:,:) = 0.e0 341 DO_3D _00_00(1, jpkm1 )341 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 342 342 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 343 343 END_3D … … 348 348 IF( iom_use("v_salttr") ) THEN 349 349 z2d(:,:) = 0._wp 350 DO_3D _00_00(1, jpkm1 )350 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 351 351 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 352 352 END_3D … … 357 357 IF( iom_use("tosmint") ) THEN 358 358 z2d(:,:) = 0._wp 359 DO_3D _00_00(1, jpkm1 )359 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 360 360 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 361 361 END_3D … … 365 365 IF( iom_use("somint") ) THEN 366 366 z2d(:,:)=0._wp 367 DO_3D _00_00(1, jpkm1 )367 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 368 368 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 369 369 END_3D -
NEMO/trunk/src/OCE/DIU/diu_bulk.F90
r12377 r13295 130 130 ! If not done already, calculate the solar fraction 131 131 IF ( kt==nit000 ) THEN 132 DO_2D _11_11132 DO_2D( 1, 1, 1, 1 ) 133 133 IF( ( x_solfrac(ji,jj) == 0._wp ) .AND. ( tmask(ji,jj,1) == 1._wp ) ) & 134 134 & x_solfrac(ji,jj) = solfrac( zcoolthick(ji,jj),zthick(ji,jj) ) … … 199 199 INTEGER :: ji,jj 200 200 201 DO_2D _11_11201 DO_2D( 1, 1, 1, 1 ) 202 202 203 203 ! Only calculate outside tmask -
NEMO/trunk/src/OCE/DIU/diu_coolskin.F90
r12489 r13295 97 97 IF( .NOT. ln_blk ) CALL ctl_stop("diu_coolskin.f90: diurnal flux processing only implemented for bulk forcing") 98 98 ! 99 DO_2D _11_1199 DO_2D( 1, 1, 1, 1 ) 100 100 ! 101 101 ! Calcualte wind speed from wind stress and friction velocity -
NEMO/trunk/src/OCE/DOM/dommsk.F90
r13286 r13295 131 131 ! 132 132 tmask(:,:,:) = 0._wp 133 DO_2D _11_11133 DO_2D( 1, 1, 1, 1 ) 134 134 iktop = k_top(ji,jj) 135 135 ikbot = k_bot(ji,jj) … … 149 149 CALL iom_get ( inum, jpdom_global, 'bdy_msk', bdytmask(:,:) ) 150 150 CALL iom_close( inum ) 151 DO_3D _11_11(1, jpkm1 )151 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 152 152 tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) 153 153 END_3D … … 157 157 ! ---------------------------------------- 158 158 ! NB: at this point, fmask is designed for free slip lateral boundary condition 159 DO_3D _00_00(1, jpk )159 DO_3D( 0, 0, 0, 0, 1, jpk ) 160 160 umask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) 161 161 vmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji ,jj+1,jk) … … 199 199 DO jk = 1, jpk 200 200 zwf(:,:) = fmask(:,:,jk) 201 DO_2D _00_00201 DO_2D( 0, 0, 0, 0 ) 202 202 IF( fmask(ji,jj,jk) == 0._wp ) THEN 203 203 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & -
NEMO/trunk/src/OCE/DOM/domqco.F90
r13286 r13295 149 149 ! 150 150 IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 151 DO_2D _00_00151 DO_2D( 0, 0, 0, 0 ) 152 152 pr3u(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & 153 153 & + e1e2t(ji+1,jj) * pssh(ji+1,jj) ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) … … 156 156 END_2D 157 157 ELSE !- Flux Form (simple averaging) 158 DO_2D _00_00158 DO_2D( 0, 0, 0, 0 ) 159 159 pr3u(ji,jj) = 0.5_wp * ( pssh(ji ,jj) + pssh(ji+1,jj) ) * r1_hu_0(ji,jj) 160 160 pr3v(ji,jj) = 0.5_wp * ( pssh(ji,jj ) + pssh(ji,jj+1) ) * r1_hv_0(ji,jj) … … 169 169 ! 170 170 IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 171 DO_2D _10_10! start from 1 since lbc_lnk('F') doesn't update the 1st row/line171 DO_2D( 1, 0, 1, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 172 172 pr3f(ji,jj) = 0.25_wp * ( e1e2t(ji ,jj ) * pssh(ji ,jj ) & 173 173 & + e1e2t(ji+1,jj ) * pssh(ji+1,jj ) & … … 176 176 END_2D 177 177 ELSE !- Flux Form (simple averaging) 178 DO_2D _10_10! start from 1 since lbc_lnk('F') doesn't update the 1st row/line178 DO_2D( 1, 0, 1, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 179 179 pr3f(ji,jj) = 0.25_wp * ( pssh(ji ,jj ) + pssh(ji+1,jj ) & 180 180 & + pssh(ji ,jj+1) + pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) … … 264 264 ssh(:,:,Kbb) = -ssh_ref 265 265 ! 266 DO_2D _11_11266 DO_2D( 1, 1, 1, 1 ) 267 267 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 268 268 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r13286 r13295 202 202 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 203 203 gdepw(:,:,1,Kbb) = 0.0_wp 204 DO_3D _11_11(2, jpk )204 DO_3D( 1, 1, 1, 1, 2, jpk ) 205 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 206 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) … … 250 250 ENDIF 251 251 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 252 DO_2D _11_11252 DO_2D( 1, 1, 1, 1 ) 253 253 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 254 254 IF( ABS(gphit(ji,jj)) >= 6.) THEN … … 419 419 zwu(:,:) = 0._wp 420 420 zwv(:,:) = 0._wp 421 DO_3D _10_10(1, jpkm1 )421 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 422 422 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 423 423 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) … … 427 427 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 428 428 END_3D 429 DO_2D _11_11429 DO_2D( 1, 1, 1, 1 ) 430 430 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 431 431 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 432 432 END_2D 433 DO_3D _00_00(1, jpkm1 )433 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 434 434 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 435 435 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & … … 659 659 gdepw(:,:,1,Kmm) = 0.0_wp 660 660 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 661 DO_3D _11_11(2, jpk )661 DO_3D( 1, 1, 1, 1, 2, jpk ) 662 662 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 663 663 ! 1 for jk = mikt … … 714 714 ! 715 715 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 716 DO_3D _10_10(1, jpk )716 DO_3D( 1, 0, 1, 0, 1, jpk ) 717 717 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 718 718 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & … … 723 723 ! 724 724 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 725 DO_3D _10_10(1, jpk )725 DO_3D( 1, 0, 1, 0, 1, jpk ) 726 726 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 727 727 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & … … 732 732 ! 733 733 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 734 DO_3D _10_10(1, jpk )734 DO_3D( 1, 0, 1, 0, 1, jpk ) 735 735 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 736 736 & * r1_e1e2f(ji,jj) & … … 899 899 ssh(:,:,Kbb) = -ssh_ref 900 900 901 DO_2D _11_11901 DO_2D( 1, 1, 1, 1 ) 902 902 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 903 903 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) … … 915 915 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 916 916 917 DO_2D _11_11917 DO_2D( 1, 1, 1, 1 ) 918 918 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 919 919 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) -
NEMO/trunk/src/OCE/DOM/domwri.F90
r13286 r13295 94 94 95 95 CALL dom_uniq( zprw, 'T' ) 96 DO_2D _11_1196 DO_2D( 1, 1, 1, 1 ) 97 97 zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj) ! ! unique point mask 98 98 END_2D 99 99 CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 ) 100 100 CALL dom_uniq( zprw, 'U' ) 101 DO_2D _11_11101 DO_2D( 1, 1, 1, 1 ) 102 102 zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj) ! ! unique point mask 103 103 END_2D 104 104 CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 ) 105 105 CALL dom_uniq( zprw, 'V' ) 106 DO_2D _11_11106 DO_2D( 1, 1, 1, 1 ) 107 107 zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj) ! ! unique point mask 108 108 END_2D -
NEMO/trunk/src/OCE/DOM/domzgr.F90
r13286 r13295 168 168 ! 169 169 ! ! ice shelf draft and bathymetry 170 DO_2D _11_11170 DO_2D( 1, 1, 1, 1 ) 171 171 ikt = mikt(ji,jj) 172 172 ikb = mbkt(ji,jj) … … 331 331 ! ! N.B. top k-index of W-level = mikt 332 332 ! ! bottom k-index of W-level = mbkt+1 333 DO_2D _10_10333 DO_2D( 1, 0, 1, 0 ) 334 334 miku(ji,jj) = MAX( mikt(ji+1,jj ) , mikt(ji,jj) ) 335 335 mikv(ji,jj) = MAX( mikt(ji ,jj+1) , mikt(ji,jj) ) -
NEMO/trunk/src/OCE/DOM/dtatsd.F90
r13286 r13295 186 186 ENDIF 187 187 ! 188 DO_2D _11_11188 DO_2D( 1, 1, 1, 1 ) 189 189 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 190 zl = gdept_0(ji,jj,jk) … … 219 219 ! 220 220 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 221 DO_2D _11_11221 DO_2D( 1, 1, 1, 1 ) 222 222 ik = mbkt(ji,jj) 223 223 IF( ik > 1 ) THEN -
NEMO/trunk/src/OCE/DOM/istate.F90
r13237 r13295 126 126 ! Apply minimum wetdepth criterion 127 127 ! 128 DO_2D _11_11128 DO_2D( 1, 1, 1, 1 ) 129 129 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 130 130 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) … … 181 181 ! 182 182 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 183 DO_3D _11_11(1, jpkm1 )183 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 184 184 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 185 185 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) -
NEMO/trunk/src/OCE/DYN/divhor.F90
r13237 r13295 77 77 ENDIF 78 78 ! 79 DO_3D _00_00(1, jpkm1 )79 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 80 80 hdiv(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) & 81 81 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) & -
NEMO/trunk/src/OCE/DYN/dynadv_cen2.F90
r13237 r13295 72 72 zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 73 73 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 74 DO_2D _10_1074 DO_2D( 1, 0, 1, 0 ) 75 75 zfu_t(ji+1,jj ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 76 76 zfv_f(ji ,jj ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) … … 78 78 zfv_t(ji ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) 79 79 END_2D 80 DO_2D _00_0080 DO_2D( 0, 0, 0, 0 ) 81 81 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 82 82 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 98 98 ! !== Vertical advection ==! 99 99 ! 100 DO_2D _00_00100 DO_2D( 0, 0, 0, 0 ) 101 101 zfu_uw(ji,jj,jpk) = 0._wp ; zfv_vw(ji,jj,jpk) = 0._wp 102 102 zfu_uw(ji,jj, 1 ) = 0._wp ; zfv_vw(ji,jj, 1 ) = 0._wp 103 103 END_2D 104 104 IF( ln_linssh ) THEN ! linear free surface: advection through the surface 105 DO_2D _00_00105 DO_2D( 0, 0, 0, 0 ) 106 106 zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 107 107 zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) … … 109 109 ENDIF 110 110 DO jk = 2, jpkm1 ! interior advective fluxes 111 DO_2D _01_01111 DO_2D( 0, 1, 0, 1 ) 112 112 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 113 113 END_2D 114 DO_2D _00_00114 DO_2D( 0, 0, 0, 0 ) 115 115 zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 116 116 zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 117 117 END_2D 118 118 END DO 119 DO_3D _00_00(1, jpkm1 )119 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 120 120 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 121 121 & / e3u(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/DYN/dynadv_ubs.F90
r13237 r13295 108 108 zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 109 109 ! 110 DO_2D _00_00110 DO_2D( 0, 0, 0, 0 ) 111 111 zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj ,jk,Kbb) ) * umask(ji,jj,jk) 112 112 zlv_vv(ji,jj,jk,1) = ( pvv (ji ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) … … 136 136 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 137 137 ! 138 DO_2D _10_10138 DO_2D( 1, 0, 1, 0 ) 139 139 zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj ,jk,Kmm) ) 140 140 zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji ,jj+1,jk,Kmm) ) … … 168 168 & * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) - gamma1 * zl_v ) 169 169 END_2D 170 DO_2D _00_00170 DO_2D( 0, 0, 0, 0 ) 171 171 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 172 172 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & … … 187 187 ! ! Vertical advection ! 188 188 ! ! ==================== ! 189 DO_2D _00_00189 DO_2D( 0, 0, 0, 0 ) 190 190 zfu_uw(ji,jj,jpk) = 0._wp 191 191 zfv_vw(ji,jj,jpk) = 0._wp … … 194 194 END_2D 195 195 IF( ln_linssh ) THEN ! constant volume : advection through the surface 196 DO_2D _00_00196 DO_2D( 0, 0, 0, 0 ) 197 197 zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 198 198 zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) … … 200 200 ENDIF 201 201 DO jk = 2, jpkm1 ! interior fluxes 202 DO_2D _01_01202 DO_2D( 0, 1, 0, 1 ) 203 203 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 204 204 END_2D 205 DO_2D _00_00205 DO_2D( 0, 0, 0, 0 ) 206 206 zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 207 207 zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 208 208 END_2D 209 209 END DO 210 DO_3D _00_00(1, jpkm1 )210 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 211 211 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 212 212 & / e3u(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/DYN/dynatf.F90
r13237 r13295 197 197 IF( ln_linssh ) THEN ! Fixed volume ! 198 198 ! ! =============! 199 DO_3D _11_11(1, jpkm1 )199 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 200 200 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 201 201 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 233 233 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 234 234 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 235 DO_3D _11_11(1, jpkm1 )235 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 236 236 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 237 237 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 244 244 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 245 245 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 246 DO_3D _11_11(1, jpkm1 )246 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 247 247 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 248 248 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) -
NEMO/trunk/src/OCE/DYN/dynatf_qco.F90
r13237 r13295 140 140 IF( ln_linssh ) THEN ! Fixed volume ! 141 141 ! ! =============! 142 DO_3D _11_11(1, jpkm1 )142 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 143 143 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 144 144 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 150 150 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 151 151 ! Before filtered scale factor at (u/v)-points 152 DO_3D _11_11(1, jpkm1 )152 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 153 153 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 154 154 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 157 157 ELSE ! Asselin filter applied on thickness weighted velocity 158 158 ! 159 DO_3D _11_11(1, jpkm1 )159 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 160 160 zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 161 161 zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) -
NEMO/trunk/src/OCE/DYN/dynhpg.F90
r13288 r13295 257 257 258 258 ! Surface value 259 DO_2D _00_00259 DO_2D( 0, 0, 0, 0 ) 260 260 zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 261 261 ! hydrostatic pressure gradient … … 269 269 ! 270 270 ! interior value (2=<jk=<jpkm1) 271 DO_3D _00_00(2, jpkm1 )271 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 272 272 zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 273 273 ! hydrostatic pressure gradient … … 319 319 320 320 ! Surface value (also valid in partial step case) 321 DO_2D _00_00321 DO_2D( 0, 0, 0, 0 ) 322 322 zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 323 323 ! hydrostatic pressure gradient … … 330 330 331 331 ! interior value (2=<jk=<jpkm1) 332 DO_3D _00_00(2, jpkm1 )332 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 333 333 zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 334 334 ! hydrostatic pressure gradient … … 346 346 347 347 ! partial steps correction at the last level (use zgru & zgrv computed in zpshde.F90) 348 DO_2D _00_00348 DO_2D( 0, 0, 0, 0 ) 349 349 iku = mbku(ji,jj) 350 350 ikv = mbkv(ji,jj) … … 411 411 ! 412 412 IF( ln_wd_il ) THEN 413 DO_2D _00_00413 DO_2D( 0, 0, 0, 0 ) 414 414 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji+1,jj,Kmm) ) > & 415 415 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 452 452 453 453 ! Surface value 454 DO_2D _00_00454 DO_2D( 0, 0, 0, 0 ) 455 455 ! hydrostatic pressure gradient along s-surfaces 456 456 zhpi(ji,jj,1) = & … … 481 481 482 482 ! interior value (2=<jk=<jpkm1) 483 DO_3D _00_00(2, jpkm1 )483 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 484 484 ! hydrostatic pressure gradient along s-surfaces 485 485 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & … … 563 563 !===== Compute surface value ===================================================== 564 564 !================================================================================== 565 DO_2D _00_00565 DO_2D( 0, 0, 0, 0 ) 566 566 ikt = mikt(ji,jj) 567 567 iktp1i = mikt(ji+1,jj) … … 592 592 !================================================================================== 593 593 ! interior value (2=<jk=<jpkm1) 594 DO_3D _00_00(2, jpkm1 )594 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 595 595 ! hydrostatic pressure gradient along s-surfaces 596 596 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & … … 643 643 IF( ln_wd_il ) THEN 644 644 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 645 DO_2D _00_00645 DO_2D( 0, 0, 0, 0 ) 646 646 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji+1,jj,Kmm) ) > & 647 647 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 699 699 !!bug gm Not a true bug, but... dzz=e3w for dzx, dzy verify what it is really 700 700 701 DO_3D _00_00(2, jpkm1 )701 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 702 702 drhoz(ji,jj,jk) = rhd (ji ,jj ,jk) - rhd (ji,jj,jk-1) 703 703 dzz (ji,jj,jk) = gde3w(ji ,jj ,jk) - gde3w(ji,jj,jk-1) … … 716 716 !!bug gm idem for drhox, drhoy et ji=jpi and jj=jpj 717 717 718 DO_3D _00_00(2, jpkm1 )718 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 719 719 cffw = 2._wp * drhoz(ji ,jj ,jk) * drhoz(ji,jj,jk-1) 720 720 … … 784 784 ! true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 785 785 786 DO_2D _00_00786 DO_2D( 0, 0, 0, 0 ) 787 787 rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) ) & 788 788 & * ( rhd(ji,jj,1) & … … 795 795 !!bug gm : optimisation: 1/10 and 1/12 the division should be done before the loop 796 796 797 DO_3D _00_00(2, jpkm1 )797 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 798 798 799 799 rho_k(ji,jj,jk) = zcoef0 * ( rhd (ji,jj,jk) + rhd (ji,jj,jk-1) ) & … … 830 830 ! Surface value 831 831 ! --------------- 832 DO_2D _00_00832 DO_2D( 0, 0, 0, 0 ) 833 833 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 834 834 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) … … 845 845 ! interior value (2=<jk=<jpkm1) 846 846 ! ---------------- 847 DO_3D _00_00(2, jpkm1 )847 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 848 848 ! hydrostatic pressure gradient along s-surfaces 849 849 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & … … 911 911 IF( ln_wd_il ) THEN 912 912 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 913 DO_2D _00_00913 DO_2D( 0, 0, 0, 0 ) 914 914 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji+1,jj,Kmm) ) > & 915 915 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 960 960 961 961 ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 962 DO_2D _11_11962 DO_2D( 1, 1, 1, 1 ) 963 963 jk = mbkt(ji,jj) 964 964 IF( jk <= 1 ) THEN ; zrhh(ji,jj, : ) = 0._wp … … 973 973 974 974 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 975 DO_2D _11_11975 DO_2D( 1, 1, 1, 1 ) 976 976 zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad 977 977 END_2D 978 978 979 DO_3D _11_11(2, jpk )979 DO_3D( 1, 1, 1, 1, 2, jpk ) 980 980 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) 981 981 END_3D … … 990 990 991 991 ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 992 DO_2D _01_01992 DO_2D( 0, 1, 0, 1 ) 993 993 zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1), & 994 994 & csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) … … 999 999 1000 1000 ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 1001 DO_3D _01_01(2, jpkm1 )1001 DO_3D( 0, 1, 0, 1, 2, jpkm1 ) 1002 1002 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + & 1003 1003 & integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk), & … … 1009 1009 1010 1010 ! Prepare zsshu_n and zsshv_n 1011 DO_2D _00_001011 DO_2D( 0, 0, 0, 0 ) 1012 1012 !!gm BUG ? if it is ssh at u- & v-point then it should be: 1013 1013 ! zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * & … … 1024 1024 CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 1025 1025 1026 DO_2D _00_001026 DO_2D( 0, 0, 0, 0 ) 1027 1027 zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad) 1028 1028 zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 1029 1029 END_2D 1030 1030 1031 DO_3D _00_00(2, jpkm1 )1031 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1032 1032 zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 1033 1033 zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 1034 1034 END_3D 1035 1035 1036 DO_3D _00_00(1, jpkm1 )1036 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1037 1037 zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 1038 1038 zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 1039 1039 END_3D 1040 1040 1041 DO_3D _00_00(1, jpkm1 )1041 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1042 1042 zu(ji,jj,jk) = MIN( zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) ) ) 1043 1043 zu(ji,jj,jk) = MAX( zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) ) ) … … 1047 1047 1048 1048 1049 DO_3D _00_00(1, jpkm1 )1049 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1050 1050 zpwes = 0._wp; zpwed = 0._wp 1051 1051 zpnss = 0._wp; zpnsd = 0._wp -
NEMO/trunk/src/OCE/DYN/dynkeg.F90
r13226 r13295 101 101 ! 102 102 CASE ( nkeg_C2 ) !-- Standard scheme --! 103 DO_3D _01_01(1, jpkm1 )103 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 104 104 zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 105 105 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) … … 109 109 END_3D 110 110 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 111 DO_3D _00_00(1, jpkm1 )111 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 112 112 zu = 8._wp * ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 113 113 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) & … … 125 125 END SELECT 126 126 ! 127 DO_3D _00_00(1, jpkm1 )127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 128 128 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 129 129 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynldf_iso.F90
r13237 r13295 128 128 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 129 129 ! 130 DO_3D _00_00(1, jpk )130 DO_3D( 0, 0, 0, 0, 1, jpk ) 131 131 uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 132 132 vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) … … 168 168 169 169 IF( ln_zps ) THEN ! z-coordinate - partial steps : min(e3u) 170 DO_2D _00_01170 DO_2D( 0, 0, 0, 1 ) 171 171 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) & 172 172 & * MIN( e3u(ji ,jj,jk,Kmm), & … … 183 183 END_2D 184 184 ELSE ! other coordinate system (zco or sco) : e3t 185 DO_2D _00_01185 DO_2D( 0, 0, 0, 1 ) 186 186 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) & 187 187 & * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) … … 199 199 200 200 ! j-flux at f-point 201 DO_2D _10_10201 DO_2D( 1, 0, 1, 0 ) 202 202 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) & 203 203 & * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) … … 219 219 ! i-flux at f-point | t | 220 220 221 DO_2D _00_10221 DO_2D( 0, 0, 1, 0 ) 222 222 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) & 223 223 & * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) … … 235 235 ! j-flux at t-point 236 236 IF( ln_zps ) THEN ! z-coordinate - partial steps : min(e3u) 237 DO_2D _01_10237 DO_2D( 0, 1, 1, 0 ) 238 238 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) & 239 239 & * MIN( e3v(ji,jj ,jk,Kmm), & … … 250 250 END_2D 251 251 ELSE ! other coordinate system (zco or sco) : e3t 252 DO_2D _01_10252 DO_2D( 0, 1, 1, 0 ) 253 253 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) & 254 254 & * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) … … 268 268 ! Second derivative (divergence) and add to the general trend 269 269 ! ----------------------------------------------------------- 270 DO_2D _00_00270 DO_2D( 0, 0, 0, 0 ) 271 271 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 272 272 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) * r1_e1e2u(ji,jj) & -
NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90
r13237 r13295 73 73 DO jk = 1, jpkm1 ! Horizontal slab 74 74 ! ! =============== 75 DO_2D _01_0175 DO_2D( 0, 1, 0, 1 ) 76 76 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 77 77 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & ! ahmf already * by fmask … … 84 84 END_2D 85 85 ! 86 DO_2D _00_0086 DO_2D( 0, 0, 0, 0 ) 87 87 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 88 88 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & -
NEMO/trunk/src/OCE/DYN/dynspg.F90
r12489 r13295 95 95 .OR. ln_ice_embd ) THEN ! embedded sea-ice 96 96 ! 97 DO_2D _00_0097 DO_2D( 0, 0, 0, 0 ) 98 98 spgu(ji,jj) = 0._wp 99 99 spgv(ji,jj) = 0._wp … … 102 102 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 103 103 zg_2 = grav * 0.5 104 DO_2D _00_00104 DO_2D( 0, 0, 0, 0 ) 105 105 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 106 106 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) … … 117 117 CALL upd_tide(zt0step, Kmm) 118 118 ! 119 DO_2D _00_00119 DO_2D( 0, 0, 0, 0 ) 120 120 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 121 121 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) … … 124 124 IF (ln_scal_load) THEN 125 125 zld = rn_scal_load * grav 126 DO_2D _00_00126 DO_2D( 0, 0, 0, 0 ) 127 127 spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 128 128 spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) … … 136 136 zgrho0r = - grav * r1_rho0 137 137 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zgrho0r 138 DO_2D _00_00138 DO_2D( 0, 0, 0, 0 ) 139 139 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 140 140 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) … … 143 143 ENDIF 144 144 ! 145 DO_3D _00_00(1, jpkm1 )145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 146 146 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 147 147 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynspg_exp.F90
r12489 r13295 74 74 IF( ln_linssh ) THEN !* linear free surface : add the surface pressure gradient trend 75 75 ! 76 DO_2D _00_0076 DO_2D( 0, 0, 0, 0 ) 77 77 spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 78 78 spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 79 79 END_2D 80 80 ! 81 DO_3D _00_00(1, jpkm1 )81 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 82 82 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 83 83 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynspg_ts.F90
r13289 r13295 264 264 IF( ln_wd_il ) THEN ! W/D : limiter applied to spgspg 265 265 CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy ) ! Calculating W/D gravity filters, zcpx and zcpy 266 DO_2D _00_00266 DO_2D( 0, 0, 0, 0 ) 267 267 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj ,Kmm) - pssh(ji ,jj ,Kmm) ) & 268 268 & * r1_e1u(ji,jj) * zcpx(ji,jj) * wdrampu(ji,jj) !jth … … 271 271 END_2D 272 272 ELSE ! now suface pressure gradient 273 DO_2D _00_00273 DO_2D( 0, 0, 0, 0 ) 274 274 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj ,Kmm) - pssh(ji ,jj ,Kmm) ) * r1_e1u(ji,jj) 275 275 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( pssh(ji ,jj+1,Kmm) - pssh(ji ,jj ,Kmm) ) * r1_e2v(ji,jj) … … 279 279 ENDIF 280 280 ! 281 DO_2D _00_00281 DO_2D( 0, 0, 0, 0 ) 282 282 zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 283 283 zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) … … 291 291 IF( ln_apr_dyn ) THEN 292 292 IF( ln_bt_fw ) THEN ! FORWARD integration: use kt+1/2 pressure (NOW+1/2) 293 DO_2D _00_00293 DO_2D( 0, 0, 0, 0 ) 294 294 zu_frc(ji,jj) = zu_frc(ji,jj) + grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 295 295 zv_frc(ji,jj) = zv_frc(ji,jj) + grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) … … 297 297 ELSE ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW) 298 298 zztmp = grav * r1_2 299 DO_2D _00_00299 DO_2D( 0, 0, 0, 0 ) 300 300 zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 301 301 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) … … 309 309 ! ! ---------------------------------- ! 310 310 IF( ln_bt_fw ) THEN ! Add wind forcing 311 DO_2D _00_00311 DO_2D( 0, 0, 0, 0 ) 312 312 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 313 313 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm) … … 315 315 ELSE 316 316 zztmp = r1_rho0 * r1_2 317 DO_2D _00_00317 DO_2D( 0, 0, 0, 0 ) 318 318 zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm) 319 319 zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm) … … 475 475 ! 476 476 ! ! ocean u- and v-depth at mid-step (separate DO-loops remove the need of a lbc_lnk) 477 DO_2D _11_10477 DO_2D( 1, 1, 1, 0 ) 478 478 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj) & 479 479 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 480 480 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask(ji,jj) 481 481 END_2D 482 DO_2D _10_11482 DO_2D( 1, 0, 1, 1 ) 483 483 zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj) & 484 484 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & … … 515 515 !-- ssh = ssh - delta_t' * [ frc + div( flux ) ] --! 516 516 !-------------------------------------------------------------------------! 517 DO_2D _00_00517 DO_2D( 0, 0, 0, 0 ) 518 518 zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 519 519 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj) … … 541 541 ! Sea Surface Height at u-,v-points (vvl case only) 542 542 IF( .NOT.ln_linssh ) THEN 543 DO_2D _00_00543 DO_2D( 0, 0, 0, 0 ) 544 544 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 545 545 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & … … 561 561 ! ! Surface pressure gradient 562 562 zldg = ( 1._wp - rn_scal_load ) * grav ! local factor 563 DO_2D _00_00563 DO_2D( 0, 0, 0, 0 ) 564 564 zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 565 565 zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) … … 579 579 ! Add tidal astronomical forcing if defined 580 580 IF ( ln_tide .AND. ln_tide_pot ) THEN 581 DO_2D _00_00581 DO_2D( 0, 0, 0, 0 ) 582 582 zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 583 583 zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) … … 588 588 !jth do implicitly instead 589 589 IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs 590 DO_2D _00_00590 DO_2D( 0, 0, 0, 0 ) 591 591 zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 592 592 zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) … … 606 606 !------------------------------------------------------------------------------------------------------------------------! 607 607 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 608 DO_2D _00_00608 DO_2D( 0, 0, 0, 0 ) 609 609 ua_e(ji,jj) = ( un_e(ji,jj) & 610 610 & + rDt_e * ( zu_spg(ji,jj) & … … 621 621 ! 622 622 ELSE !* Flux form 623 DO_2D _00_00623 DO_2D( 0, 0, 0, 0 ) 624 624 ! ! hu_e, hv_e hold depth at jn, zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 625 625 ! ! backward interpolated depth used in spg terms at jn+1/2 … … 645 645 !jth implicit bottom friction: 646 646 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 647 DO_2D _00_00647 DO_2D( 0, 0, 0, 0 ) 648 648 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj)) 649 649 va_e(ji,jj) = va_e(ji,jj) /(1.0 - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj)) … … 712 712 IF (ln_bt_fw) THEN 713 713 IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 714 DO_2D _11_11714 DO_2D( 1, 1, 1, 1 ) 715 715 zun_save = un_adv(ji,jj) 716 716 zvn_save = vn_adv(ji,jj) … … 743 743 ELSE 744 744 ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 745 DO_2D _10_10745 DO_2D( 1, 0, 1, 0 ) 746 746 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 747 747 & * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) & … … 975 975 ! Max courant number for ext. grav. waves 976 976 ! 977 DO_2D _00_00977 DO_2D( 0, 0, 0, 0 ) 978 978 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 979 979 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) … … 1100 1100 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 1101 1101 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 1102 DO_2D _10_101102 DO_2D( 1, 0, 1, 0 ) 1103 1103 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 1104 1104 & ht(ji ,jj ) + ht(ji+1,jj ) ) * 0.25_wp … … 1106 1106 END_2D 1107 1107 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 1108 DO_2D _10_101108 DO_2D( 1, 0, 1, 0 ) 1109 1109 zwz(ji,jj) = ( ht (ji ,jj+1) + ht (ji+1,jj+1) & 1110 1110 & + ht (ji ,jj ) + ht (ji+1,jj ) ) & … … 1117 1117 ! 1118 1118 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1119 DO_2D _01_011119 DO_2D( 0, 1, 0, 1 ) 1120 1120 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 1121 1121 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 1126 1126 CASE( np_EET ) != EEN scheme using e3t energy conserving scheme 1127 1127 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1128 DO_2D _01_011128 DO_2D( 0, 1, 0, 1 ) 1129 1129 z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 1130 1130 ftne(ji,jj) = ( ff_f(ji-1,jj ) + ff_f(ji ,jj ) + ff_f(ji ,jj-1) ) * z1_ht … … 1159 1159 ! 1160 1160 !zhf(:,:) = hbatf(:,:) 1161 DO_2D _10_101161 DO_2D( 1, 0, 1, 0 ) 1162 1162 zhf(ji,jj) = ( ht_0 (ji,jj ) + ht_0 (ji+1,jj ) & 1163 1163 & + ht_0 (ji,jj+1) + ht_0 (ji+1,jj+1) ) & … … 1178 1178 CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 1179 1179 ! JC: TBC. hf should be greater than 0 1180 DO_2D _11_111180 DO_2D( 1, 1, 1, 1 ) 1181 1181 IF( zhf(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zhf(ji,jj) 1182 1182 END_2D … … 1201 1201 SELECT CASE( nvor_scheme ) 1202 1202 CASE( np_ENT ) ! enstrophy conserving scheme (f-point) 1203 DO_2D _00_001203 DO_2D( 0, 0, 0, 0 ) 1204 1204 z1_hu = ssumask(ji,jj) / ( phu(ji,jj) + 1._wp - ssumask(ji,jj) ) 1205 1205 z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) … … 1214 1214 ! 1215 1215 CASE( np_ENE , np_MIX ) ! energy conserving scheme (t-point) ENE or MIX 1216 DO_2D _00_001216 DO_2D( 0, 0, 0, 0 ) 1217 1217 zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj) 1218 1218 zy2 = ( zhV(ji,jj ) + zhV(ji+1,jj ) ) * r1_e1u(ji,jj) … … 1225 1225 ! 1226 1226 CASE( np_ENS ) ! enstrophy conserving scheme (f-point) 1227 DO_2D _00_001227 DO_2D( 0, 0, 0, 0 ) 1228 1228 zy1 = r1_8 * ( zhV(ji ,jj-1) + zhV(ji+1,jj-1) & 1229 1229 & + zhV(ji ,jj ) + zhV(ji+1,jj ) ) * r1_e1u(ji,jj) … … 1235 1235 ! 1236 1236 CASE( np_EET , np_EEN ) ! energy & enstrophy scheme (using e3t or e3f) 1237 DO_2D _00_001237 DO_2D( 0, 0, 0, 0 ) 1238 1238 zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zhV(ji ,jj ) & 1239 1239 & + ftnw(ji+1,jj) * zhV(ji+1,jj ) & … … 1269 1269 ! 1270 1270 IF( ln_wd_dl_rmp ) THEN 1271 DO_2D _11_111271 DO_2D( 1, 1, 1, 1 ) 1272 1272 IF ( pssh(ji,jj) + ht_0(ji,jj) > 2._wp * rn_wdmin1 ) THEN 1273 1273 ! IF ( pssh(ji,jj) + ht_0(ji,jj) > rn_wdmin2 ) THEN … … 1280 1280 END_2D 1281 1281 ELSE 1282 DO_2D _11_111282 DO_2D( 1, 1, 1, 1 ) 1283 1283 IF ( pssh(ji,jj) + ht_0(ji,jj) > rn_wdmin1 ) THEN ; ptmsk(ji,jj) = 1._wp 1284 1284 ELSE ; ptmsk(ji,jj) = 0._wp … … 1308 1308 !!---------------------------------------------------------------------- 1309 1309 ! 1310 DO_2D _11_101310 DO_2D( 1, 1, 1, 0 ) 1311 1311 IF ( phU(ji,jj) > 0._wp ) THEN ; pUmsk(ji,jj) = pTmsk(ji ,jj) 1312 1312 ELSE ; pUmsk(ji,jj) = pTmsk(ji+1,jj) … … 1316 1316 END_2D 1317 1317 ! 1318 DO_2D _10_111318 DO_2D( 1, 0, 1, 1 ) 1319 1319 IF ( phV(ji,jj) > 0._wp ) THEN ; pVmsk(ji,jj) = pTmsk(ji,jj ) 1320 1320 ELSE ; pVmsk(ji,jj) = pTmsk(ji,jj+1) … … 1338 1338 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy 1339 1339 !!---------------------------------------------------------------------- 1340 DO_2D _00_001340 DO_2D( 0, 0, 0, 0 ) 1341 1341 ll_tmp1 = MIN( pshn(ji,jj) , pshn(ji+1,jj) ) > & 1342 1342 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & … … 1407 1407 IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities) 1408 1408 1409 DO_2D _00_001409 DO_2D( 0, 0, 0, 0 ) 1410 1410 pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 1411 1411 pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) 1412 1412 END_2D 1413 1413 ELSE ! bottom friction only 1414 DO_2D _00_001414 DO_2D( 0, 0, 0, 0 ) 1415 1415 pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 1416 1416 pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) … … 1422 1422 IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW bottom baroclinic velocities 1423 1423 1424 DO_2D _00_001424 DO_2D( 0, 0, 0, 0 ) 1425 1425 ikbu = mbku(ji,jj) 1426 1426 ikbv = mbkv(ji,jj) … … 1430 1430 ELSE ! CENTRED integration: use BEFORE bottom baroclinic velocities 1431 1431 1432 DO_2D _00_001432 DO_2D( 0, 0, 0, 0 ) 1433 1433 ikbu = mbku(ji,jj) 1434 1434 ikbv = mbkv(ji,jj) … … 1440 1440 IF( ln_wd_il ) THEN ! W/D : use the "clipped" bottom friction !!gm explain WHY, please ! 1441 1441 zztmp = -1._wp / rDt_e 1442 DO_2D _00_001442 DO_2D( 0, 0, 0, 0 ) 1443 1443 pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) * wdrampu(ji,jj) * MAX( & 1444 1444 & r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp ) … … 1448 1448 ELSE ! use "unclipped" drag (even if explicit friction is used in 3D calculation) 1449 1449 1450 DO_2D _00_001450 DO_2D( 0, 0, 0, 0 ) 1451 1451 pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj) 1452 1452 pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj) … … 1460 1460 IF( ln_bt_fw ) THEN ! FORWARD integration: use NOW top baroclinic velocity 1461 1461 1462 DO_2D _00_001462 DO_2D( 0, 0, 0, 0 ) 1463 1463 iktu = miku(ji,jj) 1464 1464 iktv = mikv(ji,jj) … … 1468 1468 ELSE ! CENTRED integration: use BEFORE top baroclinic velocity 1469 1469 1470 DO_2D _00_001470 DO_2D( 0, 0, 0, 0 ) 1471 1471 iktu = miku(ji,jj) 1472 1472 iktv = mikv(ji,jj) … … 1478 1478 ! ! use "unclipped" top drag (even if explicit friction is used in 3D calculation) 1479 1479 1480 DO_2D _00_001480 DO_2D( 0, 0, 0, 0 ) 1481 1481 pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj) 1482 1482 pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynvor.F90
r13286 r13295 231 231 CASE ( np_RVO ) !* relative vorticity 232 232 DO jk = 1, jpkm1 ! Horizontal slab 233 DO_2D _10_10233 DO_2D( 1, 0, 1, 0 ) 234 234 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 235 235 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 236 236 END_2D 237 237 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 238 DO_2D _10_10238 DO_2D( 1, 0, 1, 0 ) 239 239 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 240 240 END_2D … … 246 246 CASE ( np_CRV ) !* Coriolis + relative vorticity 247 247 DO jk = 1, jpkm1 ! Horizontal slab 248 DO_2D _10_10248 DO_2D( 1, 0, 1, 0 ) 249 249 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 250 250 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 251 251 END_2D 252 252 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 253 DO_2D _10_10253 DO_2D( 1, 0, 1, 0 ) 254 254 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 255 255 END_2D … … 269 269 zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 270 270 CASE ( np_RVO ) !* relative vorticity 271 DO_2D _01_01271 DO_2D( 0, 1, 0, 1 ) 272 272 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 273 273 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & … … 275 275 END_2D 276 276 CASE ( np_MET ) !* metric term 277 DO_2D _01_01277 DO_2D( 0, 1, 0, 1 ) 278 278 zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 279 279 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & … … 281 281 END_2D 282 282 CASE ( np_CRV ) !* Coriolis + relative vorticity 283 DO_2D _01_01283 DO_2D( 0, 1, 0, 1 ) 284 284 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 285 285 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) & … … 287 287 END_2D 288 288 CASE ( np_CME ) !* Coriolis + metric 289 DO_2D _01_01289 DO_2D( 0, 1, 0, 1 ) 290 290 zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) & 291 291 & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & … … 298 298 ! 299 299 ! !== compute and add the vorticity term trend =! 300 DO_2D _00_00300 DO_2D( 0, 0, 0, 0 ) 301 301 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 302 302 & * ( zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) ) & … … 358 358 zwz(:,:) = ff_f(:,:) 359 359 CASE ( np_RVO ) !* relative vorticity 360 DO_2D _10_10360 DO_2D( 1, 0, 1, 0 ) 361 361 zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 362 362 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 363 363 END_2D 364 364 CASE ( np_MET ) !* metric term 365 DO_2D _10_10365 DO_2D( 1, 0, 1, 0 ) 366 366 zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 367 367 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 368 368 END_2D 369 369 CASE ( np_CRV ) !* Coriolis + relative vorticity 370 DO_2D _10_10370 DO_2D( 1, 0, 1, 0 ) 371 371 zwz(ji,jj) = ff_f(ji,jj) + ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 372 372 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 373 373 END_2D 374 374 CASE ( np_CME ) !* Coriolis + metric 375 DO_2D _10_10375 DO_2D( 1, 0, 1, 0 ) 376 376 zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 377 377 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 382 382 ! 383 383 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 384 DO_2D _10_10384 DO_2D( 1, 0, 1, 0 ) 385 385 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 386 386 END_2D … … 396 396 ENDIF 397 397 ! !== compute and add the vorticity term trend =! 398 DO_2D _00_00398 DO_2D( 0, 0, 0, 0 ) 399 399 zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1) 400 400 zy2 = zwy(ji,jj ) + zwy(ji+1,jj ) … … 454 454 zwz(:,:) = ff_f(:,:) 455 455 CASE ( np_RVO ) !* relative vorticity 456 DO_2D _10_10456 DO_2D( 1, 0, 1, 0 ) 457 457 zwz(ji,jj) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 458 458 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 459 459 END_2D 460 460 CASE ( np_MET ) !* metric term 461 DO_2D _10_10461 DO_2D( 1, 0, 1, 0 ) 462 462 zwz(ji,jj) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 463 463 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 464 464 END_2D 465 465 CASE ( np_CRV ) !* Coriolis + relative vorticity 466 DO_2D _10_10466 DO_2D( 1, 0, 1, 0 ) 467 467 zwz(ji,jj) = ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 468 468 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 469 469 END_2D 470 470 CASE ( np_CME ) !* Coriolis + metric 471 DO_2D _10_10471 DO_2D( 1, 0, 1, 0 ) 472 472 zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 473 473 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 478 478 ! 479 479 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 480 DO_2D _10_10480 DO_2D( 1, 0, 1, 0 ) 481 481 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 482 482 END_2D … … 492 492 ENDIF 493 493 ! !== compute and add the vorticity term trend =! 494 DO_2D _00_00494 DO_2D( 0, 0, 0, 0 ) 495 495 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 496 496 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) … … 550 550 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 551 551 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 552 DO_2D _10_10552 DO_2D( 1, 0, 1, 0 ) 553 553 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 554 554 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 560 560 END_2D 561 561 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 562 DO_2D _10_10562 DO_2D( 1, 0, 1, 0 ) 563 563 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 564 564 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & … … 575 575 SELECT CASE( kvor ) !== vorticity considered ==! 576 576 CASE ( np_COR ) !* Coriolis (planetary vorticity) 577 DO_2D _10_10577 DO_2D( 1, 0, 1, 0 ) 578 578 zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 579 579 END_2D 580 580 CASE ( np_RVO ) !* relative vorticity 581 DO_2D _10_10581 DO_2D( 1, 0, 1, 0 ) 582 582 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 583 583 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 584 584 END_2D 585 585 CASE ( np_MET ) !* metric term 586 DO_2D _10_10586 DO_2D( 1, 0, 1, 0 ) 587 587 zwz(ji,jj,jk) = ( ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 588 588 & - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) 589 589 END_2D 590 590 CASE ( np_CRV ) !* Coriolis + relative vorticity 591 DO_2D _10_10591 DO_2D( 1, 0, 1, 0 ) 592 592 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 593 593 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 595 595 END_2D 596 596 CASE ( np_CME ) !* Coriolis + metric 597 DO_2D _10_10597 DO_2D( 1, 0, 1, 0 ) 598 598 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 599 599 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) … … 604 604 ! 605 605 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 606 DO_2D _10_10606 DO_2D( 1, 0, 1, 0 ) 607 607 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 608 608 END_2D … … 635 635 END DO 636 636 END DO 637 DO_2D _00_00637 DO_2D( 0, 0, 0, 0 ) 638 638 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 639 639 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) … … 695 695 SELECT CASE( kvor ) !== vorticity considered ==! 696 696 CASE ( np_COR ) !* Coriolis (planetary vorticity) 697 DO_2D _10_10697 DO_2D( 1, 0, 1, 0 ) 698 698 zwz(ji,jj,jk) = ff_f(ji,jj) 699 699 END_2D 700 700 CASE ( np_RVO ) !* relative vorticity 701 DO_2D _10_10701 DO_2D( 1, 0, 1, 0 ) 702 702 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 703 703 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 705 705 END_2D 706 706 CASE ( np_MET ) !* metric term 707 DO_2D _10_10707 DO_2D( 1, 0, 1, 0 ) 708 708 zwz(ji,jj,jk) = ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 709 709 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 710 710 END_2D 711 711 CASE ( np_CRV ) !* Coriolis + relative vorticity 712 DO_2D _10_10712 DO_2D( 1, 0, 1, 0 ) 713 713 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pv(ji+1,jj ,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 714 714 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) & … … 716 716 END_2D 717 717 CASE ( np_CME ) !* Coriolis + metric 718 DO_2D _10_10718 DO_2D( 1, 0, 1, 0 ) 719 719 zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 720 720 & - ( pu(ji ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) … … 725 725 ! 726 726 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 727 DO_2D _10_10727 DO_2D( 1, 0, 1, 0 ) 728 728 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 729 729 END_2D … … 758 758 END DO 759 759 END DO 760 DO_2D _00_00760 DO_2D( 0, 0, 0, 0 ) 761 761 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 762 762 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) … … 818 818 IF(lwp) WRITE(numout,*) ' change fmask value in the angles (T) ln_vorlat = ', ln_vorlat 819 819 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 820 DO_3D _10_10(1, jpk )820 DO_3D( 1, 0, 1, 0, 1, jpk ) 821 821 IF( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 822 822 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) == 3._wp ) fmask(ji,jj,jk) = 1._wp … … 857 857 CASE( np_ENT ) !* T-point metric term : pre-compute di(e2u)/2 and dj(e1v)/2 858 858 ALLOCATE( di_e2u_2(jpi,jpj), dj_e1v_2(jpi,jpj) ) 859 DO_2D _00_00859 DO_2D( 0, 0, 0, 0 ) 860 860 di_e2u_2(ji,jj) = ( e2u(ji,jj) - e2u(ji-1,jj ) ) * 0.5_wp 861 861 dj_e1v_2(ji,jj) = ( e1v(ji,jj) - e1v(ji ,jj-1) ) * 0.5_wp … … 865 865 CASE DEFAULT !* F-point metric term : pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) 866 866 ALLOCATE( di_e2v_2e1e2f(jpi,jpj), dj_e1u_2e1e2f(jpi,jpj) ) 867 DO_2D _10_10867 DO_2D( 1, 0, 1, 0 ) 868 868 di_e2v_2e1e2f(ji,jj) = ( e2v(ji+1,jj ) - e2v(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) 869 869 dj_e1u_2e1e2f(ji,jj) = ( e1u(ji ,jj+1) - e1u(ji,jj) ) * 0.5 * r1_e1e2f(ji,jj) -
NEMO/trunk/src/OCE/DYN/dynzad.F90
r13237 r13295 78 78 79 79 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 80 DO_2D _01_0180 DO_2D( 0, 1, 0, 1 ) 81 81 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 82 82 END_2D 83 DO_2D _00_0083 DO_2D( 0, 0, 0, 0 ) 84 84 zwuw(ji,jj,jk) = ( zww(ji+1,jj ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 85 85 zwvw(ji,jj,jk) = ( zww(ji ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) ) … … 88 88 ! 89 89 ! Surface and bottom advective fluxes set to zero 90 DO_2D _00_0090 DO_2D( 0, 0, 0, 0 ) 91 91 zwuw(ji,jj, 1 ) = 0._wp 92 92 zwvw(ji,jj, 1 ) = 0._wp … … 95 95 END_2D 96 96 ! 97 DO_3D _00_00(1, jpkm1 )97 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 98 98 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 99 99 & / e3u(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/DYN/dynzdf.F90
r13286 r13295 107 107 ! ! time stepping except vertical diffusion 108 108 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 109 DO_3D _00_00(1, jpkm1 )109 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 110 110 puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kbb) + rDt * puu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk) 111 111 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kbb) + rDt * pvv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk) 112 112 END_3D 113 113 ELSE ! applied on thickness weighted velocity 114 DO_3D _00_00(1, jpkm1 )114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 115 puu(ji,jj,jk,Kaa) = ( e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb ) & 116 116 & + rDt * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Krhs) ) & … … 127 127 ! G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa) 128 128 IF( ln_drgimp .AND. ln_dynspg_ts ) THEN 129 DO_3D _00_00(1, jpkm1 ) ! remove barotropic velocities129 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! remove barotropic velocities 130 130 puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - uu_b(ji,jj,Kaa) ) * umask(ji,jj,jk) 131 131 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk) 132 132 END_3D 133 DO_2D _00_00133 DO_2D( 0, 0, 0, 0 ) 134 134 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 135 135 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 142 142 END_2D 143 143 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 144 DO_2D _00_00144 DO_2D( 0, 0, 0, 0 ) 145 145 iku = miku(ji,jj) ! top ocean level at u- and v-points 146 146 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) … … 162 162 SELECT CASE( nldf_dyn ) 163 163 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 164 DO_3D _00_00(1, jpkm1 )164 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 165 165 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 166 166 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point … … 176 176 END_3D 177 177 CASE DEFAULT ! iso-level lateral mixing 178 DO_3D _00_00(1, jpkm1 )178 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 179 179 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & ! after scale factor at U-point 180 180 & + r_vvl * e3u(ji,jj,jk,Kaa) … … 190 190 END_3D 191 191 END SELECT 192 DO_2D _00_00192 DO_2D( 0, 0, 0, 0 ) 193 193 zwi(ji,jj,1) = 0._wp 194 194 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & … … 203 203 SELECT CASE( nldf_dyn ) 204 204 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 205 DO_3D _00_00(1, jpkm1 )205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 206 206 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 207 207 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point … … 215 215 END_3D 216 216 CASE DEFAULT ! iso-level lateral mixing 217 DO_3D _00_00(1, jpkm1 )217 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 218 218 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 219 219 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point … … 227 227 END_3D 228 228 END SELECT 229 DO_2D _00_00229 DO_2D( 0, 0, 0, 0 ) 230 230 zwi(ji,jj,1) = 0._wp 231 231 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 241 241 ! 242 242 IF ( ln_drgimp ) THEN ! implicit bottom friction 243 DO_2D _00_00243 DO_2D( 0, 0, 0, 0 ) 244 244 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 245 245 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & … … 248 248 END_2D 249 249 IF ( ln_isfcav ) THEN ! top friction (always implicit) 250 DO_2D _00_00250 DO_2D( 0, 0, 0, 0 ) 251 251 !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed 252 252 iku = miku(ji,jj) ! ocean top level at u- and v-points … … 273 273 !----------------------------------------------------------------------- 274 274 ! 275 DO_3D _00_00(2, jpkm1 )275 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 276 276 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 277 277 END_3D 278 278 ! 279 DO_2D _00_00279 DO_2D( 0, 0, 0, 0 ) 280 280 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 281 281 & + r_vvl * e3u(ji,jj,1,Kaa) … … 283 283 & / ( ze3ua * rho0 ) * umask(ji,jj,1) 284 284 END_2D 285 DO_3D _00_00(2, jpkm1 )285 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 286 286 puu(ji,jj,jk,Kaa) = puu(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * puu(ji,jj,jk-1,Kaa) 287 287 END_3D 288 288 ! 289 DO_2D _00_00289 DO_2D( 0, 0, 0, 0 ) 290 290 puu(ji,jj,jpkm1,Kaa) = puu(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 291 291 END_2D 292 DO_3DS _00_00(jpk-2, 1, -1 )292 DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 293 293 puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - zws(ji,jj,jk) * puu(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk) 294 294 END_3D … … 301 301 SELECT CASE( nldf_dyn ) 302 302 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv) 303 DO_3D _00_00(1, jpkm1 )303 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 304 304 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 305 305 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 315 315 END_3D 316 316 CASE DEFAULT ! iso-level lateral mixing 317 DO_3D _00_00(1, jpkm1 )317 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 318 318 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 319 319 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 329 329 END_3D 330 330 END SELECT 331 DO_2D _00_00331 DO_2D( 0, 0, 0, 0 ) 332 332 zwi(ji,jj,1) = 0._wp 333 333 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & … … 342 342 SELECT CASE( nldf_dyn ) 343 343 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 344 DO_3D _00_00(1, jpkm1 )344 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 345 345 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 346 346 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 354 354 END_3D 355 355 CASE DEFAULT ! iso-level lateral mixing 356 DO_3D _00_00(1, jpkm1 )356 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 357 357 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 358 358 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point … … 366 366 END_3D 367 367 END SELECT 368 DO_2D _00_00368 DO_2D( 0, 0, 0, 0 ) 369 369 zwi(ji,jj,1) = 0._wp 370 370 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 379 379 ! 380 380 IF( ln_drgimp ) THEN 381 DO_2D _00_00381 DO_2D( 0, 0, 0, 0 ) 382 382 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 383 383 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & … … 386 386 END_2D 387 387 IF ( ln_isfcav ) THEN 388 DO_2D _00_00388 DO_2D( 0, 0, 0, 0 ) 389 389 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 390 390 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & … … 410 410 !----------------------------------------------------------------------- 411 411 ! 412 DO_3D _00_00(2, jpkm1 )412 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 413 413 zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1) 414 414 END_3D 415 415 ! 416 DO_2D _00_00416 DO_2D( 0, 0, 0, 0 ) 417 417 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 418 418 & + r_vvl * e3v(ji,jj,1,Kaa) … … 420 420 & / ( ze3va * rho0 ) * vmask(ji,jj,1) 421 421 END_2D 422 DO_3D _00_00(2, jpkm1 )422 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 423 423 pvv(ji,jj,jk,Kaa) = pvv(ji,jj,jk,Kaa) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pvv(ji,jj,jk-1,Kaa) 424 424 END_3D 425 425 ! 426 DO_2D _00_00426 DO_2D( 0, 0, 0, 0 ) 427 427 pvv(ji,jj,jpkm1,Kaa) = pvv(ji,jj,jpkm1,Kaa) / zwd(ji,jj,jpkm1) 428 428 END_2D 429 DO_3DS _00_00(jpk-2, 1, -1 )429 DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 430 430 pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - zws(ji,jj,jk) * pvv(ji,jj,jk+1,Kaa) ) / zwd(ji,jj,jk) 431 431 END_3D -
NEMO/trunk/src/OCE/DYN/sshwzv.F90
r13286 r13295 178 178 ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 179 179 ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 180 DO_2D _00_00180 DO_2D( 0, 0, 0, 0 ) 181 181 zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 182 182 END_2D … … 358 358 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 359 359 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 360 DO_3D _00_00(1, jpkm1 )360 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 361 361 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 362 362 Cu_adv(ji,jj,jk) = zdt * & … … 375 375 END_3D 376 376 ELSE 377 DO_3D _00_00(1, jpkm1 )377 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 378 378 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 379 379 Cu_adv(ji,jj,jk) = zdt * & … … 393 393 ! 394 394 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 395 DO_3DS _11_11(jpkm1, 2, -1 )395 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 396 396 ! 397 397 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) -
NEMO/trunk/src/OCE/DYN/wet_dry.F90
r13237 r13295 174 174 ! 175 175 wdmask(:,:) = 1._wp 176 DO_2D _01_01176 DO_2D( 0, 1, 0, 1 ) 177 177 ! 178 178 IF( tmask(ji,jj,1) < 0.5_wp ) CYCLE ! we don't care about land cells … … 198 198 wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 199 199 !jth assume don't need a lbc_lnk here 200 DO_2D _10_10200 DO_2D( 1, 0, 1, 0 ) 201 201 wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) ) 202 202 wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) ) … … 211 211 jflag = 0 ! flag indicating if any further iterations are needed 212 212 ! 213 DO_2D _01_01213 DO_2D( 0, 1, 0, 1 ) 214 214 IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE 215 215 IF( ht_0(ji,jj) > zdepwd ) CYCLE … … 307 307 zwdlmtv(:,:) = 1._wp 308 308 ! 309 DO_2D _01_01309 DO_2D( 0, 1, 0, 1 ) 310 310 ! 311 311 IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells … … 333 333 jflag = 0 ! flag indicating if any further iterations are needed 334 334 ! 335 DO_2D _01_01335 DO_2D( 0, 1, 0, 1 ) 336 336 ! 337 337 IF( tmask(ji, jj, 1 ) < 0.5_wp ) CYCLE -
NEMO/trunk/src/OCE/ICB/icbclv.F90
r12377 r13295 71 71 ! where (berg_grid%calving==0.) berg_grid%stored_ice(:,:,jn)=0. 72 72 !end do 73 DO_2D _00_0073 DO_2D( 0, 0, 0, 0 ) 74 74 IF( berg_grid%calving(ji,jj) /= 0._wp ) & ! Need units of J 75 75 berg_grid%stored_heat(ji,jj) = SUM( berg_grid%stored_ice(ji,jj,:) ) * & ! initial stored ice in kg … … 81 81 ! assume that all calving flux must be distributed even if distribution array does not sum 82 82 ! to one - this may not be what is intended, but it's what you've got 83 DO_2D _11_1183 DO_2D( 1, 1, 1, 1 ) 84 84 imx = berg_grid%maxclass(ji,jj) 85 85 zdist = SUM( rn_distribution(1:nclasses) ) / SUM( rn_distribution(1:imx) ) -
NEMO/trunk/src/OCE/ICB/icbini.F90
r13286 r13295 123 123 nicbfldproc(:) = -1 124 124 125 DO_2D _11_11125 DO_2D( 1, 1, 1, 1 ) 126 126 src_calving_hflx(ji,jj) = narea 127 127 src_calving (ji,jj) = nicbpack * mjg(jj) + mig(ji) -
NEMO/trunk/src/OCE/IOM/iom.F90
r13286 r13295 2255 2255 ! 2256 2256 ! Cell vertices that can be defined 2257 DO_2D _00_002257 DO_2D( 0, 0, 0, 0 ) 2258 2258 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2259 2259 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right … … 2266 2266 END_2D 2267 2267 ! 2268 DO_2D _00_002268 DO_2D( 0, 0, 0, 0 ) 2269 2269 IF( z_fld(ji,jj) == -1. ) THEN 2270 2270 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) -
NEMO/trunk/src/OCE/ISF/isfcavmlt.F90
r12489 r13295 210 210 ! compute upward heat flux zhtflx and upward water flux zwflx 211 211 ! Resolution of a 3d equation from equation 24, 25 and 26 (note conduction through the ice has been added to Eq 24) 212 DO_2D _11_11212 DO_2D( 1, 1, 1, 1 ) 213 213 ! 214 214 ! compute coeficient to solve the 2nd order equation -
NEMO/trunk/src/OCE/ISF/isfcpl.F90
r13286 r13295 194 194 ! 195 195 zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:) 196 DO_2D _00_00196 DO_2D( 0, 0, 0, 0 ) 197 197 jip1=ji+1; jim1=ji-1; 198 198 jjp1=jj+1; jjm1=jj-1; … … 317 317 zdmask(:,:) = tmask(:,:,jk) - ztmask0(:,:,jk); 318 318 ! 319 DO_2D _00_00319 DO_2D( 0, 0, 0, 0 ) 320 320 jip1=ji+1; jim1=ji-1; 321 321 jjp1=jj+1; jjm1=jj-1; … … 378 378 ! ----------------------------------------------------------------------------------------- 379 379 ! case we open a cell but no neigbour cells available to get an estimate of T and S 380 DO_3D _11_11(1,jpk-1 )380 DO_3D( 1, 1, 1, 1, 1,jpk-1 ) 381 381 IF (tmask(ji,jj,jk) == 1._wp .AND. ts(ji,jj,jk,2,Kmm) == 0._wp) & 382 382 & CALL ctl_stop('STOP', 'failing to fill all new weet cell, & … … 418 418 DO jk = 1, jpk ! Horizontal slab 419 419 ! 1.1: get volume flux before coupling (>0 out) 420 DO_2D _00_00420 DO_2D( 0, 0, 0, 0 ) 421 421 zqvolb(ji,jj,jk) = & 422 422 & ( e2u(ji ,jj ) * ze3u_b(ji ,jj ,jk) * uu(ji ,jj ,jk,Kmm) & … … 433 433 vv(:,:,jk,Kmm) = vv(:,:,jk,Kmm) * vmask(:,:,jk) 434 434 ! compute volume flux divergence after coupling 435 DO_2D _00_00435 DO_2D( 0, 0, 0, 0 ) 436 436 zqvoln(ji,jj,jk) = & 437 437 & ( e2u(ji ,jj ) * e3u(ji ,jj ,jk,Kmm) * uu(ji ,jj ,jk,Kmm) & … … 449 449 ! 2.0: include the contribution of the vertical velocity in the volume flux correction 450 450 ! 451 DO_2D _00_00451 DO_2D( 0, 0, 0, 0 ) 452 452 ! 453 453 ikt = mikt(ji,jj) -
NEMO/trunk/src/OCE/ISF/isfdiags.F90
r13237 r13295 101 101 zvar3d(:,:,:) = 0._wp 102 102 ! 103 DO_2D _11_11103 DO_2D( 1, 1, 1, 1 ) 104 104 ikt = ktop(ji,jj) 105 105 ikb = kbot(ji,jj) -
NEMO/trunk/src/OCE/ISF/isfhdiv.F90
r13237 r13295 100 100 ! 101 101 ! update divergence at each level affected by ice shelf top boundary layer 102 DO_2D _11_11102 DO_2D( 1, 1, 1, 1 ) 103 103 ikt = ktop(ji,jj) 104 104 ikb = kbot(ji,jj) -
NEMO/trunk/src/OCE/ISF/isfload.F90
r13237 r13295 94 94 ! !- Surface value + ice shelf gradient 95 95 pisfload(:,:) = 0._wp ! compute pressure due to ice shelf load 96 DO_2D _11_1196 DO_2D( 1, 1, 1, 1 ) 97 97 ikt = mikt(ji,jj) 98 98 ! -
NEMO/trunk/src/OCE/ISF/isftbl.F90
r13237 r13295 78 78 ! compute tbl property at T point 79 79 pvarout(1,:) = 0._wp 80 DO_2D _11_0180 DO_2D( 1, 1, 0, 1 ) 81 81 pvarout(ji,jj) = 0.5_wp * (zvarout(ji,jj) + zvarout(ji-1,jj)) 82 82 END_2D … … 99 99 ! pvarout is an averaging of wet point 100 100 pvarout(:,1) = 0._wp 101 DO_2D _01_11101 DO_2D( 0, 1, 1, 1 ) 102 102 pvarout(ji,jj) = 0.5_wp * (zvarout(ji,jj) + zvarout(ji,jj-1)) 103 103 END_2D … … 138 138 ! 139 139 ! compute tbl top.bottom level and thickness 140 DO_2D _11_11140 DO_2D( 1, 1, 1, 1 ) 141 141 ! 142 142 ! tbl top/bottom indices initialisation … … 176 176 ! 177 177 ! get htbl 178 DO_2D _11_11178 DO_2D( 1, 1, 1, 1 ) 179 179 ! 180 180 ! tbl top/bottom indices initialisation … … 193 193 ! 194 194 ! get pfrac 195 DO_2D _11_11195 DO_2D( 1, 1, 1, 1 ) 196 196 ! 197 197 ! tbl top/bottom indices initialisation … … 227 227 ! 228 228 ! get ktbl 229 DO_2D _11_11229 DO_2D( 1, 1, 1, 1 ) 230 230 ! 231 231 ! determine the deepest level influenced by the boundary layer … … 261 261 ! test: this routine run with pdep = 0 should return 1 262 262 ! 263 DO_2D _11_11263 DO_2D( 1, 1, 1, 1 ) 264 264 ! comput ktop 265 265 ikt = 2 -
NEMO/trunk/src/OCE/LDF/ldfc1d_c2d.F90
r13226 r13295 80 80 pah1(:,:,jk) = pahs1(:,:) * ( zratio + zc * ( 1._wp + TANH( - ( gdept_0(:,:,jk) - zh ) * zw) ) ) 81 81 END DO 82 DO_3DS _10_10(jpkm1, 1, -1 )82 DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 ) 83 83 zdep2 = ( gdept_0(ji,jj+1,jk) + gdept_0(ji+1,jj+1,jk) & 84 84 & + gdept_0(ji,jj ,jk) + gdept_0(ji+1,jj ,jk) ) * r1_4 … … 88 88 ! 89 89 CASE( 'TRA' ) ! U- and V-points (zdep1 & 2 are an approximation in zps-coord.) 90 DO_3DS _10_10(jpkm1, 1, -1 )90 DO_3DS( 1, 0, 1, 0, jpkm1, 1, -1 ) 91 91 zdep1 = ( gdept_0(ji,jj,jk) + gdept_0(ji+1,jj,jk) ) * 0.5_wp 92 92 zdep2 = ( gdept_0(ji,jj,jk) + gdept_0(ji,jj+1,jk) ) * 0.5_wp … … 135 135 ! 136 136 CASE( 'DYN' ) ! T- and F-points 137 DO_2D _11_11137 DO_2D( 1, 1, 1, 1 ) 138 138 pah1(ji,jj,1) = pUfac * MAX( e1t(ji,jj) , e2t(ji,jj) )**knn 139 139 pah2(ji,jj,1) = pUfac * MAX( e1f(ji,jj) , e2f(ji,jj) )**knn 140 140 END_2D 141 141 CASE( 'TRA' ) ! U- and V-points 142 DO_2D _11_11142 DO_2D( 1, 1, 1, 1 ) 143 143 pah1(ji,jj,1) = pUfac * MAX( e1u(ji,jj), e2u(ji,jj) )**knn 144 144 pah2(ji,jj,1) = pUfac * MAX( e1v(ji,jj), e2v(ji,jj) )**knn -
NEMO/trunk/src/OCE/LDF/ldfdyn.F90
r13286 r13295 311 311 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays') 312 312 ! 313 DO_2D _11_11313 DO_2D( 1, 1, 1, 1 ) 314 314 esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2 315 315 esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2 … … 368 368 IF( ln_dynldf_lap ) THEN ! laplacian operator : |u| e /12 = |u/144| e 369 369 DO jk = 1, jpkm1 370 DO_2D _00_00370 DO_2D( 0, 0, 0, 0 ) 371 371 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 372 372 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) … … 374 374 ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk) ! 288= 12*12 * 2 375 375 END_2D 376 DO_2D _10_10376 DO_2D( 1, 0, 1, 0 ) 377 377 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb) 378 378 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb) … … 383 383 ELSEIF( ln_dynldf_blp ) THEN ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e 384 384 DO jk = 1, jpkm1 385 DO_2D _00_00385 DO_2D( 0, 0, 0, 0 ) 386 386 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) 387 387 zu2pv2_ij_m1 = uu(ji-1,jj ,jk,Kbb) * uu(ji-1,jj ,jk,Kbb) + vv(ji ,jj-1,jk,Kbb) * vv(ji ,jj-1,jk,Kbb) … … 389 389 ahmt(ji,jj,jk) = SQRT( SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax ) * zemax * tmask(ji,jj,jk) 390 390 END_2D 391 DO_2D _10_10391 DO_2D( 1, 0, 1, 0 ) 392 392 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, Kbb) * uu(ji ,jj+1,jk, Kbb) + vv(ji+1,jj ,jk, Kbb) * vv(ji+1,jj ,jk, Kbb) 393 393 zu2pv2_ij = uu(ji ,jj ,jk, Kbb) * uu(ji ,jj ,jk, Kbb) + vv(ji ,jj ,jk, Kbb) * vv(ji ,jj ,jk, Kbb) … … 412 412 DO jk = 1, jpkm1 413 413 ! 414 DO_2D _00_00414 DO_2D( 0, 0, 0, 0 ) 415 415 zdb = ( uu(ji,jj,jk,Kbb) * r1_e2u(ji,jj) - uu(ji-1,jj,jk,Kbb) * r1_e2u(ji-1,jj) ) & 416 416 & * r1_e1t(ji,jj) * e2t(ji,jj) & … … 420 420 END_2D 421 421 ! 422 DO_2D _10_10422 DO_2D( 1, 0, 1, 0 ) 423 423 zdb = ( uu(ji,jj+1,jk,Kbb) * r1_e1u(ji,jj+1) - uu(ji,jj,jk,Kbb) * r1_e1u(ji,jj) ) & 424 424 & * r1_e2f(ji,jj) * e1f(ji,jj) & … … 434 434 DO jk = 1, jpkm1 435 435 ! 436 DO_2D _00_00436 DO_2D( 0, 0, 0, 0 ) 437 437 ! 438 438 zu2pv2_ij = uu(ji ,jj ,jk,Kbb) * uu(ji ,jj ,jk,Kbb) + vv(ji ,jj ,jk,Kbb) * vv(ji ,jj ,jk,Kbb) … … 448 448 END_2D 449 449 ! 450 DO_2D _10_10450 DO_2D( 1, 0, 1, 0 ) 451 451 ! 452 452 zu2pv2_ij_p1 = uu(ji ,jj+1,jk, kbb) * uu(ji ,jj+1,jk, kbb) + vv(ji+1,jj ,jk, kbb) * vv(ji+1,jj ,jk, kbb) … … 471 471 ! ! effective default limits are 1/12 |U|L^3 < B_hm < 1//(32*2dt) L^4 472 472 DO jk = 1, jpkm1 473 DO_2D _00_00473 DO_2D( 0, 0, 0, 0 ) 474 474 ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) ) 475 475 END_2D 476 DO_2D _10_10476 DO_2D( 1, 0, 1, 0 ) 477 477 ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) ) 478 478 END_2D -
NEMO/trunk/src/OCE/LDF/ldfslp.F90
r13237 r13295 137 137 zwz(:,:,:) = 0._wp 138 138 ! 139 DO_3D _10_10(1, jpk )139 DO_3D( 1, 0, 1, 0, 1, jpk ) 140 140 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 141 141 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 142 142 END_3D 143 143 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 144 DO_2D _10_10144 DO_2D( 1, 0, 1, 0 ) 145 145 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 146 146 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) … … 148 148 ENDIF 149 149 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 150 DO_2D _10_10150 DO_2D( 1, 0, 1, 0 ) 151 151 IF( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 152 152 IF( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) … … 173 173 ! 174 174 IF ( ln_isfcav ) THEN 175 DO_2D _00_00175 DO_2D( 0, 0, 0, 0 ) 176 176 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt (ji+1,jj ), 5._wp) & 177 177 & - MAX(risfdep(ji,jj), risfdep(ji+1,jj ) ) ) … … 180 180 END_2D 181 181 ELSE 182 DO_2D _00_00182 DO_2D( 0, 0, 0, 0 ) 183 183 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 184 184 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) … … 186 186 END IF 187 187 188 DO_3D _00_00(2, jpkm1 )188 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 189 189 ! ! horizontal and vertical density gradient at u- and v-points 190 190 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) … … 233 233 ! !* horizontal Shapiro filter 234 234 DO jk = 2, jpkm1 235 DO_2D _00_00235 DO_2D( 0, 0, 0, 0 ) 236 236 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 237 237 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & … … 260 260 END DO 261 261 ! !* decrease along coastal boundaries 262 DO_2D _00_00262 DO_2D( 0, 0, 0, 0 ) 263 263 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 264 264 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp … … 272 272 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 273 273 ! 274 DO_3D _00_00(2, jpkm1 )274 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 275 275 ! !* Local vertical density gradient evaluated from N^2 276 276 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) … … 307 307 ! !* horizontal Shapiro filter 308 308 DO jk = 2, jpkm1 309 DO_2D _00_00309 DO_2D( 0, 0, 0, 0 ) 310 310 zcofw = wmask(ji,jj,jk) * z1_16 311 311 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & … … 338 338 END DO 339 339 ! !* decrease in vicinity of topography 340 DO_2D _00_00340 DO_2D( 0, 0, 0, 0 ) 341 341 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 342 342 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 … … 401 401 ! 402 402 ip = jl ; jp = jl ! guaranteed nonzero gradients ( absolute value larger than repsln) 403 DO_3D _10_10(1, jpkm1 )403 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 404 404 zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) ) ! i-gradient of T & S at u-point 405 405 zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) … … 413 413 ! 414 414 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 415 DO_2D _10_10415 DO_2D( 1, 0, 1, 0 ) 416 416 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 417 417 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature … … 427 427 428 428 DO kp = 0, 1 !== unmasked before density i- j-, k-gradients ==! 429 DO_3D _11_11(1, jpkm1 )429 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 430 430 IF( jk+kp > 1 ) THEN ! k-gradient of T & S a jk+kp 431 431 zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) ) … … 442 442 END DO 443 443 ! 444 DO_2D _11_11444 DO_2D( 1, 1, 1, 1 ) 445 445 jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1 ! MIN in case ML depth is the ocean depth 446 446 z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm) … … 462 462 DO jl = 0, 1 ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 463 463 DO kp = 0, 1 ! with only the slope-max limit and MASKED 464 DO_2D _10_10464 DO_2D( 1, 0, 1, 0 ) 465 465 ip = jl ; jp = jl 466 466 ! … … 499 499 ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 500 500 znot_thru_surface = REAL( 1-1/(jk+kp), wp ) !jk+kp=1,=0.; otherwise=1.0 501 DO_2D _10_10501 DO_2D( 1, 0, 1, 0 ) 502 502 ! 503 503 ! Calculate slope relative to geopotentials used for GM skew fluxes … … 628 628 ! 629 629 ! !== surface mixed layer mask ! 630 DO_3D _11_11(1, jpk )630 DO_3D( 1, 1, 1, 1, 1, jpk ) 631 631 ik = nmln(ji,jj) - 1 632 632 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 646 646 !----------------------------------------------------------------------- 647 647 ! 648 DO_2D _00_00648 DO_2D( 0, 0, 0, 0 ) 649 649 ! !== Slope at u- & v-points just below the Mixed Layer ==! 650 650 ! -
NEMO/trunk/src/OCE/LDF/ldftra.F90
r13286 r13295 430 430 zaht_min = 0.2_wp * aht0 ! minimum value for aht 431 431 zDaht = aht0 - zaht_min 432 DO_2D _11_11432 DO_2D( 1, 1, 1, 1 ) 433 433 !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg) 434 434 !! ==>>> The Coriolis value is identical for t- & u_points, and for v- and f-points … … 648 648 ! ! Compute lateral diffusive coefficient at T-point 649 649 IF( ln_traldf_triad ) THEN 650 DO_3D _00_00(1, jpk )650 DO_3D( 0, 0, 0, 0, 1, jpk ) 651 651 ! Take the max of N^2 and zero then take the vertical sum 652 652 ! of the square root of the resulting N^2 ( required to compute … … 662 662 END_3D 663 663 ELSE 664 DO_3D _00_00(1, jpk )664 DO_3D( 0, 0, 0, 0, 1, jpk ) 665 665 ! Take the max of N^2 and zero then take the vertical sum 666 666 ! of the square root of the resulting N^2 ( required to compute … … 678 678 ENDIF 679 679 680 DO_2D _00_00680 DO_2D( 0, 0, 0, 0 ) 681 681 zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 682 682 ! Rossby radius at w-point taken betwenn 2 km and 40km … … 688 688 ! !== Bound on eiv coeff. ==! 689 689 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 690 DO_2D _00_00690 DO_2D( 0, 0, 0, 0 ) 691 691 zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj) ! tropical decrease 692 692 zaeiw(ji,jj) = MIN( zzaei , paei0 ) ! Max value = paei0 … … 694 694 CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp ) ! lateral boundary condition 695 695 ! 696 DO_2D _00_00696 DO_2D( 0, 0, 0, 0 ) 697 697 paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj ) ) * umask(ji,jj,1) 698 698 paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji ,jj+1) ) * vmask(ji,jj,1) … … 750 750 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 751 751 ! 752 DO_3D _10_10(2, jpkm1 )752 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 753 753 zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk ) + wslpi(ji+1,jj,jk) ) & 754 754 & * ( aeiu (ji,jj,jk-1) + aeiu (ji ,jj,jk) ) * wumask(ji,jj,jk) … … 757 757 END_3D 758 758 ! 759 DO_3D _10_10(1, jpkm1 )759 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 760 760 pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 761 761 pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 762 762 END_3D 763 DO_3D _00_00(1, jpkm1 )763 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 764 764 pw(ji,jj,jk) = pw(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj ,jk) & 765 765 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji ,jj-1,jk) ) … … 813 813 CALL iom_put( "voce_eiv", zw3d ) 814 814 ! 815 DO_3D _00_00(1, jpkm1 )815 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 816 816 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) & 817 817 & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj) … … 840 840 zw2d(:,:) = 0._wp 841 841 zw3d(:,:,:) = 0._wp 842 DO_3D _00_00(1, jpkm1 )842 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 843 843 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1) - psi_uw(ji ,jj,jk) ) & 844 844 & * ( ts (ji,jj,jk,jp_tem,Kmm) + ts (ji+1,jj,jk,jp_tem,Kmm) ) … … 861 861 zw2d(:,:) = 0._wp 862 862 zw3d(:,:,:) = 0._wp 863 DO_3D _00_00(1, jpkm1 )863 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 864 864 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj ,jk) ) & 865 865 & * ( ts (ji,jj,jk,jp_tem,Kmm) + ts (ji,jj+1,jk,jp_tem,Kmm) ) … … 876 876 zw2d(:,:) = 0._wp 877 877 zw3d(:,:,:) = 0._wp 878 DO_3D _00_00(1, jpkm1 )878 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 879 879 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1) - psi_uw(ji ,jj,jk) ) & 880 880 & * ( ts (ji,jj,jk,jp_sal,Kmm) + ts (ji+1,jj,jk,jp_sal,Kmm) ) … … 888 888 zw2d(:,:) = 0._wp 889 889 zw3d(:,:,:) = 0._wp 890 DO_3D _00_00(1, jpkm1 )890 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 891 891 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj ,jk) ) & 892 892 & * ( ts (ji,jj,jk,jp_sal,Kmm) + ts (ji,jj+1,jk,jp_sal,Kmm) ) -
NEMO/trunk/src/OCE/OBS/obs_oper.F90
r12377 r13295 189 189 ! Initialize daily mean for first timestep of the day 190 190 IF ( idayend == 1 .OR. kt == 0 ) THEN 191 DO_3D _11_11(1, jpk )191 DO_3D( 1, 1, 1, 1, 1, jpk ) 192 192 prodatqc%vdmean(ji,jj,jk,1) = 0.0 193 193 prodatqc%vdmean(ji,jj,jk,2) = 0.0 … … 195 195 ENDIF 196 196 197 DO_3D _11_11(1, jpk )197 DO_3D( 1, 1, 1, 1, 1, jpk ) 198 198 ! Increment field 1 for computing daily mean 199 199 prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & … … 209 209 IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt 210 210 CALL FLUSH(numout) 211 DO_3D _11_11(1, jpk )211 DO_3D( 1, 1, 1, 1, 1, jpk ) 212 212 prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 213 213 & * zdaystp … … 750 750 ! Initialize night-time mean for first timestep of the day 751 751 IF ( idayend == 1 .OR. kt == 0 ) THEN 752 DO_2D _11_11752 DO_2D( 1, 1, 1, 1 ) 753 753 surfdataqc%vdmean(ji,jj) = 0.0 754 754 zmeanday(ji,jj) = 0.0 … … 761 761 imask_night(:,:) = INT( zouttmp(:,:) ) 762 762 763 DO_2D _11_11763 DO_2D( 1, 1, 1, 1 ) 764 764 ! Increment the temperature field for computing night mean and counter 765 765 surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) & … … 773 773 IF ( idayend == 0 ) THEN 774 774 IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt 775 DO_2D _11_11775 DO_2D( 1, 1, 1, 1 ) 776 776 ! Test if "no night" point 777 777 IF ( icount_night(ji,jj) > 0 ) THEN -
NEMO/trunk/src/OCE/OBS/obs_readmdt.F90
r13286 r13295 215 215 zeta2 = 0.0 216 216 217 DO_2D _11_11217 DO_2D( 1, 1, 1, 1 ) 218 218 zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) 219 219 zarea = zarea + zdxdy -
NEMO/trunk/src/OCE/SBC/cyclone.F90
r12377 r13295 147 147 zb = 2. 148 148 149 DO_2D _11_11149 DO_2D( 1, 1, 1, 1 ) 150 150 151 151 ! calc distance between TC center and any point following great circle … … 208 208 ENDIF 209 209 210 DO_2D _11_11210 DO_2D( 1, 1, 1, 1 ) 211 211 212 212 zzrglam = rad * glamt(ji,jj) - zrlon -
NEMO/trunk/src/OCE/SBC/fldread.F90
r13286 r13295 1169 1169 WRITE(clname,'(a3,i2.2)') 'src',jn 1170 1170 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1171 DO_2D _00_001171 DO_2D( 0, 0, 0, 0 ) 1172 1172 isrc = NINT(data_tmp(ji,jj)) - 1 1173 1173 ref_wgts(nxt_wgt)%data_jpi(ji,jj,jn) = 1 + MOD(isrc, ref_wgts(nxt_wgt)%ddims(1)) … … 1179 1179 WRITE(clname,'(a3,i2.2)') 'wgt',jn 1180 1180 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1181 DO_2D _00_001181 DO_2D( 0, 0, 0, 0 ) 1182 1182 ref_wgts(nxt_wgt)%data_wgt(ji,jj,jn) = data_tmp(ji,jj) 1183 1183 END_2D … … 1442 1442 dta(:,:,:) = 0._wp 1443 1443 DO jn = 1,4 1444 DO_3D _00_00(1,ipk )1444 DO_3D( 0, 0, 0, 0, 1,ipk ) 1445 1445 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 1446 1446 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 … … 1486 1486 ! 1487 1487 !!$ DO jn = 1,4 1488 !!$ DO_3D _00_00(1,ipk )1488 !!$ DO_3D( 0, 0, 0, 0, 1,ipk ) 1489 1489 !!$ ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 1490 1490 !!$ nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 … … 1504 1504 ! 1505 1505 DO jn = 1,4 1506 DO_3D _00_00(1,ipk )1506 DO_3D( 0, 0, 0, 0, 1,ipk ) 1507 1507 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1508 1508 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) … … 1513 1513 END DO 1514 1514 DO jn = 1,4 1515 DO_3D _00_00(1,ipk )1515 DO_3D( 0, 0, 0, 0, 1,ipk ) 1516 1516 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1517 1517 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) … … 1522 1522 END DO 1523 1523 DO jn = 1,4 1524 DO_3D _00_00(1,ipk )1524 DO_3D( 0, 0, 0, 0, 1,ipk ) 1525 1525 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1526 1526 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) -
NEMO/trunk/src/OCE/SBC/geo2ocean.F90
r13226 r13295 160 160 ! (computation done on the north stereographic polar plane) 161 161 ! 162 DO_2D _00_01162 DO_2D( 0, 0, 0, 1 ) 163 163 ! 164 164 zlam = plamt(ji,jj) ! north pole direction & modulous (at t-point) … … 249 249 ! =============== ! 250 250 251 DO_2D _00_01251 DO_2D( 0, 0, 0, 1 ) 252 252 IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN 253 253 gsint(ji,jj) = 0. -
NEMO/trunk/src/OCE/SBC/sbc_oce.F90
r13226 r13295 217 217 !!--------------------------------------------------------------------- 218 218 zcoef = 0.5 / ( zrhoa * zcdrag ) 219 DO_2D _00_00219 DO_2D( 0, 0, 0, 0 ) 220 220 ztx = utau(ji-1,jj ) + utau(ji,jj) 221 221 zty = vtau(ji ,jj-1) + vtau(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcblk.F90
r13226 r13295 568 568 zwnd_j(:,:) = 0._wp 569 569 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) 570 DO_2D _11_11570 DO_2D( 1, 1, 1, 1 ) 571 571 zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 572 572 zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) … … 576 576 #else 577 577 ! ... scalar wind module at T-point (not masked) 578 DO_2D _11_11578 DO_2D( 1, 1, 1, 1 ) 579 579 wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 580 580 END_2D … … 628 628 ! use scalar version of gamma_moist() ... 629 629 IF( ln_tpot ) THEN 630 DO_2D _11_11630 DO_2D( 1, 1, 1, 1 ) 631 631 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 632 632 END_2D … … 690 690 691 691 IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp 692 DO_2D _11_11692 DO_2D( 1, 1, 1, 1 ) 693 693 zztmp = zU_zu(ji,jj) 694 694 wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod … … 710 710 pevp(:,:) = pevp(:,:) * tmask(:,:,1) 711 711 712 DO_2D _11_11712 DO_2D( 1, 1, 1, 1 ) 713 713 IF( wndm(ji,jj) > 0._wp ) THEN 714 714 zztmp = taum(ji,jj) / wndm(ji,jj) … … 728 728 IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715) 729 729 zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0) 730 DO_2D _01_01! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop730 DO_2D( 0, 1, 0, 1 ) ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop 731 731 zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) ! stau (<0) must be smaller than zstmax 732 732 ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) ) … … 739 739 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 740 740 ! Note that coastal wind stress is not used in the code... so this extra care has no effect 741 DO_2D _00_00! start loop at 2, in case ln_crt_fbk = T741 DO_2D( 0, 0, 0, 0 ) ! start loop at 2, in case ln_crt_fbk = T 742 742 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj ) ) & 743 743 & * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) … … 828 828 829 829 ! use scalar version of L_vap() for AGRIF compatibility 830 DO_2D _11_11830 DO_2D( 1, 1, 1, 1 ) 831 831 zqla(ji,jj) = - L_vap( ztskk(ji,jj) ) * pevp(ji,jj) ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 832 832 END_2D … … 933 933 ! ------------------------------------------------------------ ! 934 934 ! C-grid ice dynamics : U & V-points (same as ocean) 935 DO_2D _11_11935 DO_2D( 1, 1, 1, 1 ) 936 936 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 937 937 END_2D … … 959 959 ! ---------------------------------------------------- ! 960 960 ! supress moving ice in wind stress computation as we don't know how to do it properly... 961 DO_2D _01_01! at T point961 DO_2D( 0, 1, 0, 1 ) ! at T point 962 962 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 963 963 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 964 964 END_2D 965 965 ! 966 DO_2D _00_00! U & V-points (same as ocean).966 DO_2D( 0, 0, 0, 0 ) ! U & V-points (same as ocean). 967 967 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 968 968 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) … … 978 978 zztmp1 = 11637800.0_wp 979 979 zztmp2 = -5897.8_wp 980 DO_2D _11_11980 DO_2D( 1, 1, 1, 1 ) 981 981 pcd_dui(ji,jj) = zcd_dui (ji,jj) 982 982 pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) … … 1233 1233 ! 1234 1234 DO jl = 1, jpl 1235 DO_2D _11_111235 DO_2D( 1, 1, 1, 1 ) 1236 1236 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness 1237 1237 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor … … 1248 1248 ! 1249 1249 DO jl = 1, jpl 1250 DO_2D _11_111250 DO_2D( 1, 1, 1, 1 ) 1251 1251 ! 1252 1252 zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness … … 1396 1396 zqi_sat(:,:) = q_sat( ptm_su(:,:), pslp(:,:) ) ! saturation humidity over ice [kg/kg] 1397 1397 ! 1398 DO_2D _00_001398 DO_2D( 0, 0, 0, 0 ) 1399 1399 ! Virtual potential temperature [K] 1400 1400 zthetav_os = zst(ji,jj) * ( 1._wp + rctv0 * zqo_sat(ji,jj) ) ! over ocean -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r12615 r13295 394 394 !!------------------------------------------------------------------- 395 395 ! 396 DO_2D _11_11396 DO_2D( 1, 1, 1, 1 ) 397 397 ! 398 398 zw = pwnd(ji,jj) ! wind speed … … 430 430 !!---------------------------------------------------------------------------------- 431 431 ! 432 DO_2D _11_11432 DO_2D( 1, 1, 1, 1 ) 433 433 ! 434 434 zta = pzeta(ji,jj) … … 481 481 REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 482 482 ! 483 DO_2D _11_11483 DO_2D( 1, 1, 1, 1 ) 484 484 ! 485 485 zta = pzeta(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r12615 r13295 430 430 !!---------------------------------------------------------------------------------- 431 431 ! 432 DO_2D _11_11432 DO_2D( 1, 1, 1, 1 ) 433 433 ! 434 434 zta = pzeta(ji,jj) … … 481 481 REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 482 482 ! 483 DO_2D _11_11483 DO_2D( 1, 1, 1, 1 ) 484 484 ! 485 485 zta = pzeta(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r12615 r13295 410 410 REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 411 411 !!---------------------------------------------------------------------------------- 412 DO_2D _11_11412 DO_2D( 1, 1, 1, 1 ) 413 413 ! 414 414 zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): … … 455 455 !!---------------------------------------------------------------------------------- 456 456 ! 457 DO_2D _11_11457 DO_2D( 1, 1, 1, 1 ) 458 458 ! 459 459 zzeta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!): -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_ncar.F90
r12615 r13295 241 241 !!---------------------------------------------------------------------------------- 242 242 ! 243 DO_2D _11_11243 DO_2D( 1, 1, 1, 1 ) 244 244 ! 245 245 zw = pw10(ji,jj) … … 277 277 REAL(wp) :: zx2, zx, zstab ! local scalars 278 278 !!---------------------------------------------------------------------------------- 279 DO_2D _11_11279 DO_2D( 1, 1, 1, 1 ) 280 280 zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 281 281 zx2 = MAX( zx2 , 1._wp ) … … 308 308 !!---------------------------------------------------------------------------------- 309 309 ! 310 DO_2D _11_11310 DO_2D( 1, 1, 1, 1 ) 311 311 zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 312 312 zx2 = MAX( zx2 , 1._wp ) -
NEMO/trunk/src/OCE/SBC/sbcblk_phy.F90
r13165 r13295 181 181 !!---------------------------------------------------------------------------------- 182 182 ! 183 DO_2D _11_11183 DO_2D( 1, 1, 1, 1 ) 184 184 ztc = ptak(ji,jj) - rt0 ! air temp, in deg. C 185 185 ztc2 = ztc*ztc … … 270 270 INTEGER :: ji, jj ! dummy loop indices 271 271 !!---------------------------------------------------------------------------------- 272 DO_2D _11_11272 DO_2D( 1, 1, 1, 1 ) 273 273 gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) ) 274 274 END_2D … … 315 315 !!------------------------------------------------------------------- 316 316 ! 317 DO_2D _11_11317 DO_2D( 1, 1, 1, 1 ) 318 318 ! 319 319 zqa = (1._wp + rctv0*pqa(ji,jj)) … … 351 351 !!------------------------------------------------------------------- 352 352 ! 353 DO_2D _11_11353 DO_2D( 1, 1, 1, 1 ) 354 354 ! 355 355 zqa = 0.5_wp*(pqa(ji,jj)+pssq(ji,jj)) ! ~ mean q within the layer... … … 448 448 !!---------------------------------------------------------------------------------- 449 449 ! 450 DO_2D _11_11450 DO_2D( 1, 1, 1, 1 ) 451 451 ! 452 452 ze_sat = e_sat_sclr( ptak(ji,jj) ) … … 473 473 !!---------------------------------------------------------------------------------- 474 474 ! 475 DO_2D _11_11475 DO_2D( 1, 1, 1, 1 ) 476 476 ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj)) 477 477 q_air_rh(ji,jj) = ze*reps0/(pslp(ji,jj) - (1. - reps0)*ze) … … 511 511 INTEGER :: ji, jj ! dummy loop indices 512 512 !!---------------------------------------------------------------------------------- 513 DO_2D _11_11513 DO_2D( 1, 1, 1, 1 ) 514 514 515 515 zdt = pTa(ji,jj) - pTs(ji,jj) ; zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt ) … … 621 621 IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 622 622 623 DO_2D _11_11623 DO_2D( 1, 1, 1, 1 ) 624 624 625 625 CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & -
NEMO/trunk/src/OCE/SBC/sbcblk_skin_coare.F90
r12489 r13295 89 89 REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus 90 90 !!--------------------------------------------------------------------- 91 DO_2D _11_1191 DO_2D( 1, 1, 1, 1 ) 92 92 93 93 zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, … … 156 156 ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ... 157 157 158 DO_2D _11_11158 DO_2D( 1, 1, 1, 1 ) 159 159 160 160 l_exit = .FALSE. -
NEMO/trunk/src/OCE/SBC/sbcblk_skin_ecmwf.F90
r12489 r13295 95 95 REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus 96 96 !!--------------------------------------------------------------------- 97 DO_2D _11_1197 DO_2D( 1, 1, 1, 1 ) 98 98 99 99 zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, … … 173 173 IF( PRESENT(pustk) ) l_pustk_known = .TRUE. 174 174 175 DO_2D _11_11175 DO_2D( 1, 1, 1, 1 ) 176 176 177 177 zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !) -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r13286 r13295 1170 1170 ! 1171 1171 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1172 DO_2D _00_001172 DO_2D( 0, 0, 0, 0 ) 1173 1173 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1174 1174 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) … … 1194 1194 ! => need to be done only when otx1 was changed 1195 1195 IF( llnewtx ) THEN 1196 DO_2D _00_001196 DO_2D( 0, 0, 0, 0 ) 1197 1197 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1198 1198 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) … … 1219 1219 IF( llnewtau ) THEN 1220 1220 zcoef = 1. / ( zrhoa * zcdrag ) 1221 DO_2D _11_111221 DO_2D( 1, 1, 1, 1 ) 1222 1222 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1223 1223 END_2D … … 1549 1549 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1550 1550 CASE( 'T' ) 1551 DO_2D _00_001551 DO_2D( 0, 0, 0, 0 ) 1552 1552 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1553 1553 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) … … 2365 2365 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2366 2366 CASE( 'oce only' ) ! C-grid ==> T 2367 DO_2D _00_002367 DO_2D( 0, 0, 0, 0 ) 2368 2368 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2369 2369 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2370 2370 END_2D 2371 2371 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2372 DO_2D _00_002372 DO_2D( 0, 0, 0, 0 ) 2373 2373 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2374 2374 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2378 2378 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2379 2379 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2380 DO_2D _00_002380 DO_2D( 0, 0, 0, 0 ) 2381 2381 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2382 2382 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2442 2442 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2443 2443 CASE( 'oce only' ) ! C-grid ==> T 2444 DO_2D _00_002444 DO_2D( 0, 0, 0, 0 ) 2445 2445 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2446 2446 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2447 2447 END_2D 2448 2448 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2449 DO_2D _00_002449 DO_2D( 0, 0, 0, 0 ) 2450 2450 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2451 2451 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2455 2455 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2456 2456 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2457 DO_2D _00_002457 DO_2D( 0, 0, 0, 0 ) 2458 2458 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2459 2459 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcdcy.F90
r12489 r13295 110 110 111 111 imask_night(:,:) = 0 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 ztmpm = 0._wp 114 114 IF( ABS(rab(ji,jj)) < 1. ) THEN ! day duration is less than 24h … … 193 193 194 194 zsin = SIN( zdecrad ) ; zcos = COS( zdecrad ) 195 DO_2D _11_11195 DO_2D( 1, 1, 1, 1 ) 196 196 ztmp = rad * gphit(ji,jj) 197 197 raa(ji,jj) = SIN( ztmp ) * zsin … … 202 202 ! rab to test if the day time is equal to 0, less than 24h of full day 203 203 rab(:,:) = -raa(:,:) / rbb(:,:) 204 DO_2D _11_11204 DO_2D( 1, 1, 1, 1 ) 205 205 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 206 206 ! When is it night? … … 226 226 ! Avoid possible infinite scaling factor, associated with very short daylight 227 227 ! periods, by ignoring periods less than 1/1000th of a day (ticket #1040) 228 DO_2D _11_11228 DO_2D( 1, 1, 1, 1 ) 229 229 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 230 230 rscal(ji,jj) = 0.0_wp -
NEMO/trunk/src/OCE/SBC/sbcflx.F90
r13226 r13295 129 129 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 130 130 ENDIF 131 DO_2D _11_11131 DO_2D( 1, 1, 1, 1 ) 132 132 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 133 133 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) … … 143 143 ! ! module of wind stress and wind speed at T-point 144 144 zcoef = 1. / ( zrhoa * zcdrag ) 145 DO_2D _00_00145 DO_2D( 0, 0, 0, 0 ) 146 146 ztx = utau(ji-1,jj ) + utau(ji,jj) 147 147 zty = vtau(ji ,jj-1) + vtau(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcice_cice.F90
r13286 r13295 217 217 ! T point to U point 218 218 ! T point to V point 219 DO_2D _10_10219 DO_2D( 1, 0, 1, 0 ) 220 220 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 221 221 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) … … 312 312 ! x comp of wind stress (CI_1) 313 313 ! U point to F point 314 DO_2D _10_11314 DO_2D( 1, 0, 1, 1 ) 315 315 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 316 316 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) … … 320 320 ! y comp of wind stress (CI_2) 321 321 ! V point to F point 322 DO_2D _11_10322 DO_2D( 1, 1, 1, 0 ) 323 323 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 324 324 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) … … 335 335 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub 336 336 ! End of temporary code 337 DO_2D _11_11337 DO_2D( 1, 1, 1, 1 ) 338 338 IF(fr_i(ji,jj).eq.0.0) THEN 339 339 DO jl=1,ncat … … 437 437 ! x comp and y comp of surface ocean current 438 438 ! U point to F point 439 DO_2D _10_11439 DO_2D( 1, 0, 1, 1 ) 440 440 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 441 441 END_2D … … 443 443 444 444 ! V point to F point 445 DO_2D _11_10445 DO_2D( 1, 1, 1, 0 ) 446 446 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 447 447 END_2D … … 467 467 ! x comp and y comp of sea surface slope (on F points) 468 468 ! T point to F point 469 DO_2D _10_10469 DO_2D( 1, 0, 1, 0 ) 470 470 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 471 471 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) … … 474 474 475 475 ! T point to F point 476 DO_2D _10_10476 DO_2D( 1, 0, 1, 0 ) 477 477 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 478 478 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) … … 503 503 ss_iou(:,:)=0.0 504 504 ! F point to U point 505 DO_2D _00_00505 DO_2D( 0, 0, 0, 0 ) 506 506 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 507 507 END_2D … … 513 513 ! F point to V point 514 514 515 DO_2D _10_00515 DO_2D( 1, 0, 0, 0 ) 516 516 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 517 517 END_2D … … 597 597 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1.0_wp ) 598 598 599 DO_2D _11_11599 DO_2D( 1, 1, 1, 1 ) 600 600 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 601 601 END_2D … … 621 621 ! T point to U point 622 622 ! T point to V point 623 DO_2D _10_10623 DO_2D( 1, 0, 1, 0 ) 624 624 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 625 625 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) … … 981 981 982 982 pn(:,:)=0.0 983 DO_2D _10_10983 DO_2D( 1, 0, 1, 0 ) 984 984 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 985 985 END_2D -
NEMO/trunk/src/OCE/SBC/sbcice_if.F90
r12377 r13295 109 109 110 110 ! Flux and ice fraction computation 111 DO_2D _11_11111 DO_2D( 1, 1, 1, 1 ) 112 112 ! 113 113 zt_fzp = fr_i(ji,jj) ! freezing point temperature -
NEMO/trunk/src/OCE/SBC/sbcrnf.F90
r13286 r13295 209 209 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 210 210 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 211 DO_2D _11_11211 DO_2D( 1, 1, 1, 1 ) 212 212 DO jk = 1, nk_rnf(ji,jj) 213 213 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) … … 215 215 END_2D 216 216 ELSE !* variable volume case 217 DO_2D _11_11217 DO_2D( 1, 1, 1, 1 ) 218 218 h_rnf(ji,jj) = 0._wp 219 219 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres … … 361 361 ! 362 362 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 363 DO_2D _11_11363 DO_2D( 1, 1, 1, 1 ) 364 364 IF( h_rnf(ji,jj) > 0._wp ) THEN 365 365 jk = 2 … … 374 374 ENDIF 375 375 END_2D 376 DO_2D _11_11376 DO_2D( 1, 1, 1, 1 ) 377 377 h_rnf(ji,jj) = 0._wp 378 378 DO jk = 1, nk_rnf(ji,jj) … … 404 404 WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs 405 405 ! 406 DO_2D _11_11406 DO_2D( 1, 1, 1, 1 ) 407 407 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 408 408 jk = mbkt(ji,jj) … … 412 412 ! 413 413 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 414 DO_2D _11_11414 DO_2D( 1, 1, 1, 1 ) 415 415 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 416 416 jk = 2 … … 423 423 END_2D 424 424 ! 425 DO_2D _11_11425 DO_2D( 1, 1, 1, 1 ) 426 426 h_rnf(ji,jj) = 0._wp 427 427 DO jk = 1, nk_rnf(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcssr.F90
r13226 r13295 95 95 ! 96 96 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 97 DO_2D _11_1197 DO_2D( 1, 1, 1, 1 ) 98 98 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 99 99 qns(ji,jj) = qns(ji,jj) + zqrp … … 105 105 ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 106 106 ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 107 DO_2D _11_11107 DO_2D( 1, 1, 1, 1 ) 108 108 SELECT CASE ( nn_sssr_ice ) 109 109 CASE ( 0 ) ; coefice(ji,jj) = 1._wp - fr_i(ji,jj) ! no/reduced damping under ice … … 115 115 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 116 116 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 117 DO_2D _11_11117 DO_2D( 1, 1, 1, 1 ) 118 118 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 119 119 & * coefice(ji,jj) & ! Optional control of damping under sea-ice … … 126 126 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 127 127 zerp_bnd = rn_sssr_bnd / rday ! - - 128 DO_2D _11_11128 DO_2D( 1, 1, 1, 1 ) 129 129 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 130 130 & * coefice(ji,jj) & ! Optional control of damping under sea-ice -
NEMO/trunk/src/OCE/SBC/sbcwave.F90
r13237 r13295 113 113 IF( ll_st_bv_li ) THEN ! (Eq. (19) in Breivik et al. (2014) ) 114 114 zfac = 2.0_wp * rpi / 16.0_wp 115 DO_2D _11_11115 DO_2D( 1, 1, 1, 1 ) 116 116 ! Stokes drift velocity estimated from Hs and Tmean 117 117 ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp ) … … 121 121 zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp ) 122 122 END_2D 123 DO_2D _10_10123 DO_2D( 1, 0, 1, 0 ) 124 124 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 125 125 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) … … 129 129 END_2D 130 130 ELSE IF( ll_st_peakfr ) THEN ! peak wave number calculated from the peak frequency received by the wave model 131 DO_2D _11_11131 DO_2D( 1, 1, 1, 1 ) 132 132 zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav 133 133 END_2D 134 DO_2D _10_10134 DO_2D( 1, 0, 1, 0 ) 135 135 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 136 136 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) … … 143 143 ! !== horizontal Stokes Drift 3D velocity ==! 144 144 IF( ll_st_bv2014 ) THEN 145 DO_3D _00_00(1, jpkm1 )145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 146 146 zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) ) 147 147 zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) ) … … 158 158 ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN 159 159 ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) ) 160 DO_2D _10_10160 DO_2D( 1, 0, 1, 0 ) 161 161 zstokes_psi_u_top(ji,jj) = 0._wp 162 162 zstokes_psi_v_top(ji,jj) = 0._wp … … 164 164 zsqrtpi = SQRT(rpi) 165 165 z_two_thirds = 2.0_wp / 3.0_wp 166 DO_3D _00_00(1, jpkm1 )166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 167 167 zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) ) ! 2 * bottom depth 168 168 zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) ) ! 2 * bottom depth … … 204 204 ! !== vertical Stokes Drift 3D velocity ==! 205 205 ! 206 DO_3D _01_01(1, jpkm1 )206 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 207 207 ze3divh(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * usd(ji ,jj,jk) & 208 208 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) & … … 263 263 ! 264 264 IF( ln_tauw ) THEN 265 DO_2D _10_10265 DO_2D( 1, 0, 1, 0 ) 266 266 ! Stress components at u- & v-points 267 267 utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) ) -
NEMO/trunk/src/OCE/STO/stopar.F90
r13286 r13295 837 837 REAL(wp) :: gran ! Gaussian random number (forced KIND=8 as in kiss_gaussian) 838 838 839 DO_2D _11_11839 DO_2D( 1, 1, 1, 1 ) 840 840 CALL kiss_gaussian( gran ) 841 841 psto(ji,jj) = gran … … 855 855 INTEGER :: ji, jj 856 856 857 DO_2D _00_00857 DO_2D( 0, 0, 0, 0 ) 858 858 psto(ji,jj) = 0.5_wp * psto(ji,jj) + 0.125_wp * & 859 859 & ( psto(ji-1,jj) + psto(ji+1,jj) + & -
NEMO/trunk/src/OCE/STO/stopts.F90
r12377 r13295 95 95 ! Eliminate any possible negative salinity 96 96 DO jdof = 1, nn_sto_eos 97 DO_3D _11_11(1, jpkm1 )97 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 98 98 pts_ran(ji,jj,jk,jp_sal,jdof) = MIN( ABS(pts_ran(ji,jj,jk,jp_sal,jdof)) , & 99 99 & MAX(pts(ji,jj,jk,jp_sal),0._wp) ) & -
NEMO/trunk/src/OCE/TRA/eosbn2.F90
r13237 r13295 238 238 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 239 239 ! 240 DO_3D _11_11(1, jpkm1 )240 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 241 241 ! 242 242 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 274 274 CASE( np_seos ) !== simplified EOS ==! 275 275 ! 276 DO_3D _11_11(1, jpkm1 )276 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 277 277 zt = pts (ji,jj,jk,jp_tem) - 10._wp 278 278 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 338 338 END DO 339 339 ! 340 DO_3D _11_11(1, jpkm1 )340 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 341 341 ! 342 342 ! compute density (2*nn_sto_eos) times: … … 388 388 ! Non-stochastic equation of state 389 389 ELSE 390 DO_3D _11_11(1, jpkm1 )390 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 391 391 ! 392 392 zh = pdep(ji,jj,jk) * r1_Z0 ! depth … … 426 426 CASE( np_seos ) !== simplified EOS ==! 427 427 ! 428 DO_3D _11_11(1, jpkm1 )428 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 429 429 zt = pts (ji,jj,jk,jp_tem) - 10._wp 430 430 zs = pts (ji,jj,jk,jp_sal) - 35._wp … … 480 480 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 481 481 ! 482 DO_2D _11_11482 DO_2D( 1, 1, 1, 1 ) 483 483 ! 484 484 zh = pdep(ji,jj) * r1_Z0 ! depth … … 515 515 CASE( np_seos ) !== simplified EOS ==! 516 516 ! 517 DO_2D _11_11517 DO_2D( 1, 1, 1, 1 ) 518 518 ! 519 519 zt = pts (ji,jj,jp_tem) - 10._wp … … 563 563 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 564 564 ! 565 DO_3D _11_11(1, jpkm1 )565 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 566 566 ! 567 567 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth … … 616 616 CASE( np_seos ) !== simplified EOS ==! 617 617 ! 618 DO_3D _11_11(1, jpkm1 )618 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 619 619 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 620 620 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) … … 670 670 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 671 671 ! 672 DO_2D _11_11672 DO_2D( 1, 1, 1, 1 ) 673 673 ! 674 674 zh = pdep(ji,jj) * r1_Z0 ! depth … … 723 723 CASE( np_seos ) !== simplified EOS ==! 724 724 ! 725 DO_2D _11_11725 DO_2D( 1, 1, 1, 1 ) 726 726 ! 727 727 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) … … 873 873 IF( ln_timing ) CALL timing_start('bn2') 874 874 ! 875 DO_3D _11_11(2, jpkm1 )875 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 876 876 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 877 877 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) … … 921 921 z1_T0 = 1._wp/40._wp 922 922 ! 923 DO_2D _11_11923 DO_2D( 1, 1, 1, 1 ) 924 924 ! 925 925 zt = ctmp (ji,jj) * z1_T0 … … 974 974 ! 975 975 z1_S0 = 1._wp / 35.16504_wp 976 DO_2D _11_11976 DO_2D( 1, 1, 1, 1 ) 977 977 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 978 978 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & … … 1081 1081 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1082 1082 ! 1083 DO_3D _11_11(1, jpkm1 )1083 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1084 1084 ! 1085 1085 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth … … 1140 1140 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1141 1141 ! 1142 DO_3D _11_11(1, jpkm1 )1142 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1143 1143 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1144 1144 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) -
NEMO/trunk/src/OCE/TRA/traadv_cen.F90
r13237 r13295 104 104 ! 105 105 CASE( 2 ) !* 2nd order centered 106 DO_3D _10_10(1, jpkm1 )106 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 107 107 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ) 108 108 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) ) … … 112 112 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 113 113 ztv(:,:,jpk) = 0._wp 114 DO_3D _00_00(1, jpkm1 )114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 115 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 116 116 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) … … 118 118 CALL lbc_lnk_multi( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. 119 119 ! 120 DO_3D _00_10(1, jpkm1 )120 DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 121 121 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! C2 interpolation of T at u- & v-points (x2) 122 122 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 136 136 ! 137 137 CASE( 2 ) !* 2nd order centered 138 DO_3D _00_00(2, jpk )138 DO_3D( 0, 0, 0, 0, 2, jpk ) 139 139 zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) * wmask(ji,jj,jk) 140 140 END_3D … … 142 142 CASE( 4 ) !* 4th order compact 143 143 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! ztw = interpolated value of T at w-point 144 DO_3D _00_00(2, jpkm1 )144 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 145 145 zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 146 146 END_3D … … 150 150 IF( ln_linssh ) THEN !* top value (linear free surf. only as zwz is multiplied by wmask) 151 151 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 152 DO_2D _11_11152 DO_2D( 1, 1, 1, 1 ) 153 153 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) 154 154 END_2D … … 158 158 ENDIF 159 159 ! 160 DO_3D _00_00(1, jpkm1 )160 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 161 161 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 162 162 & - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & -
NEMO/trunk/src/OCE/TRA/traadv_fct.F90
r13286 r13295 139 139 IF( ll_zAimp ) THEN 140 140 ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 141 DO_3D _00_00(1, jpkm1 )141 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 142 142 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & 143 143 & / e3t(ji,jj,jk,Krhs) … … 151 151 ! !== upstream advection with initial mass fluxes & intermediate update ==! 152 152 ! !* upstream tracer flux in the i and j direction 153 DO_3D _10_10(1, jpkm1 )153 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 154 154 ! upstream scheme 155 155 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) … … 161 161 END_3D 162 162 ! !* upstream tracer flux in the k direction *! 163 DO_3D _11_11(2, jpkm1 )163 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 164 164 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 165 165 zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) … … 168 168 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 169 169 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 170 DO_2D _11_11170 DO_2D( 1, 1, 1, 1 ) 171 171 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 172 172 END_2D 173 173 ELSE ! no cavities: only at the ocean surface 174 DO_2D _11_11174 DO_2D( 1, 1, 1, 1 ) 175 175 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 176 176 END_2D … … 178 178 ENDIF 179 179 ! 180 DO_3D _00_00(1, jpkm1 )180 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 181 181 ! ! total intermediate advective trends 182 182 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 194 194 ! 195 195 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 196 DO_3D _00_00(2, jpkm1 )196 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 197 197 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 198 198 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 200 200 zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes 201 201 END_3D 202 DO_3D _00_00(1, jpkm1 )202 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 203 203 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) & 204 204 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) … … 218 218 ! 219 219 CASE( 2 ) !- 2nd order centered 220 DO_3D _10_10(1, jpkm1 )220 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 221 221 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 222 222 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) … … 227 227 zltv(:,:,jpk) = 0._wp 228 228 DO jk = 1, jpkm1 ! Laplacian 229 DO_2D _10_10229 DO_2D( 1, 0, 1, 0 ) 230 230 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 231 231 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 232 232 END_2D 233 DO_2D _00_00233 DO_2D( 0, 0, 0, 0 ) 234 234 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) + ztu(ji-1,jj,jk) ) * r1_6 235 235 zltv(ji,jj,jk) = ( ztv(ji,jj,jk) + ztv(ji,jj-1,jk) ) * r1_6 … … 238 238 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 239 239 ! 240 DO_3D _10_10(1, jpkm1 )240 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 241 241 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points 242 242 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 249 249 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 250 250 ztv(:,:,jpk) = 0._wp 251 DO_3D _10_10(1, jpkm1 )251 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 252 252 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 253 253 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) … … 255 255 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 256 256 ! 257 DO_3D _00_00(1, jpkm1 )257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 258 258 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points (x2) 259 259 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 271 271 ! 272 272 CASE( 2 ) !- 2nd order centered 273 DO_3D _00_00(2, jpkm1 )273 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 274 274 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 275 275 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) … … 278 278 CASE( 4 ) !- 4th order COMPACT 279 279 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 280 DO_3D _00_00(2, jpkm1 )280 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 281 281 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 282 282 END_3D … … 288 288 ! 289 289 IF ( ll_zAimp ) THEN 290 DO_3D _00_00(1, jpkm1 )290 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 291 291 ! ! total intermediate advective trends 292 292 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 298 298 CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 299 299 ! 300 DO_3D _00_00(2, jpkm1 )300 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 301 301 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 302 302 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 313 313 ! !== final trend with corrected fluxes ==! 314 314 ! 315 DO_3D _00_00(1, jpkm1 )315 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 316 316 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 317 317 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & … … 324 324 ! 325 325 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp 326 DO_3D _00_00(2, jpkm1 )326 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 327 327 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 328 328 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 330 330 zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic 331 331 END_3D 332 DO_3D _00_00(1, jpkm1 )332 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 333 333 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) & 334 334 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) … … 409 409 DO jk = 1, jpkm1 410 410 ikm1 = MAX(jk-1,1) 411 DO_2D _00_00411 DO_2D( 0, 0, 0, 0 ) 412 412 413 413 ! search maximum in neighbourhood … … 443 443 ! 3. monotonic flux in the i & j direction (paa & pbb) 444 444 ! ---------------------------------------- 445 DO_3D _00_00(1, jpkm1 )445 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 446 446 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 447 447 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) … … 481 481 !!---------------------------------------------------------------------- 482 482 483 DO_3D _11_11(3, jpkm1 )483 DO_3D( 1, 1, 1, 1, 3, jpkm1 ) 484 484 zwd (ji,jj,jk) = 4._wp 485 485 zwi (ji,jj,jk) = 1._wp … … 496 496 ! 497 497 jk = 2 ! Switch to second order centered at top 498 DO_2D _11_11498 DO_2D( 1, 1, 1, 1 ) 499 499 zwd (ji,jj,jk) = 1._wp 500 500 zwi (ji,jj,jk) = 0._wp … … 504 504 ! 505 505 ! !== tridiagonal solve ==! 506 DO_2D _11_11506 DO_2D( 1, 1, 1, 1 ) 507 507 zwt(ji,jj,2) = zwd(ji,jj,2) 508 508 END_2D 509 DO_3D _11_11(3, jpkm1 )509 DO_3D( 1, 1, 1, 1, 3, jpkm1 ) 510 510 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 511 511 END_3D 512 512 ! 513 DO_2D _11_11513 DO_2D( 1, 1, 1, 1 ) 514 514 pt_out(ji,jj,2) = zwrm(ji,jj,2) 515 515 END_2D 516 DO_3D _11_11(3, jpkm1 )516 DO_3D( 1, 1, 1, 1, 3, jpkm1 ) 517 517 pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 518 518 END_3D 519 519 520 DO_2D _11_11520 DO_2D( 1, 1, 1, 1 ) 521 521 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 522 522 END_2D 523 DO_3DS _11_11(jpk-2, 2, -1 )523 DO_3DS( 1, 1, 1, 1, jpk-2, 2, -1 ) 524 524 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 525 525 END_3D … … 546 546 ! !== build the three diagonal matrix & the RHS ==! 547 547 ! 548 DO_3D _00_00(3, jpkm1 )548 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 549 549 zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp ! diagonal 550 550 zwi (ji,jj,jk) = wmask(ji,jj,jk) ! lower diagonal … … 565 565 END IF 566 566 ! 567 DO_2D _00_00567 DO_2D( 0, 0, 0, 0 ) 568 568 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 569 569 ikb = MAX(mbkt(ji,jj), 2) ! - above the last wet point … … 582 582 ! !== tridiagonal solver ==! 583 583 ! 584 DO_2D _00_00584 DO_2D( 0, 0, 0, 0 ) 585 585 zwt(ji,jj,2) = zwd(ji,jj,2) 586 586 END_2D 587 DO_3D _00_00(3, jpkm1 )587 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 588 588 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 589 589 END_3D 590 590 ! 591 DO_2D _00_00591 DO_2D( 0, 0, 0, 0 ) 592 592 pt_out(ji,jj,2) = zwrm(ji,jj,2) 593 593 END_2D 594 DO_3D _00_00(3, jpkm1 )594 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 595 595 pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 596 596 END_3D 597 597 598 DO_2D _00_00598 DO_2D( 0, 0, 0, 0 ) 599 599 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 600 600 END_2D 601 DO_3DS _00_00(jpk-2, 2, -1 )601 DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 602 602 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 603 603 END_3D … … 638 638 kstart = 1 + klev 639 639 ! 640 DO_2D _00_00640 DO_2D( 0, 0, 0, 0 ) 641 641 zwt(ji,jj,kstart) = pD(ji,jj,kstart) 642 642 END_2D 643 DO_3D _00_00(kstart+1, jpkm1 )643 DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 ) 644 644 zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 645 645 END_3D 646 646 ! 647 DO_2D _00_00647 DO_2D( 0, 0, 0, 0 ) 648 648 pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 649 649 END_2D 650 DO_3D _00_00(kstart+1, jpkm1 )650 DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 ) 651 651 pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 652 652 END_3D 653 653 654 DO_2D _00_00654 DO_2D( 0, 0, 0, 0 ) 655 655 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 656 656 END_2D 657 DO_3DS _00_00(jpk-2, kstart, -1 )657 DO_3DS( 0, 0, 0, 0, jpk-2, kstart, -1 ) 658 658 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 659 659 END_3D -
NEMO/trunk/src/OCE/TRA/traadv_mus.F90
r13237 r13295 132 132 zwx(:,:,jpk) = 0._wp ! bottom values 133 133 zwy(:,:,jpk) = 0._wp 134 DO_3D _10_10(1, jpkm1 )134 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 135 135 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 136 136 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) … … 141 141 zslpx(:,:,jpk) = 0._wp ! bottom values 142 142 zslpy(:,:,jpk) = 0._wp 143 DO_3D _01_01(1, jpkm1 )143 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 144 144 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 145 145 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 148 148 END_3D 149 149 ! 150 DO_3D _01_01(1, jpkm1 )150 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 151 151 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 152 152 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 157 157 END_3D 158 158 ! 159 DO_3D _00_00(1, jpkm1 )159 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 160 160 ! MUSCL fluxes 161 161 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) … … 175 175 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign) 176 176 ! 177 DO_3D _00_00(1, jpkm1 )177 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 178 178 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 179 179 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & … … 200 200 ! !-- Slopes of tracer 201 201 zslpx(:,:,1) = 0._wp ! surface values 202 DO_3D _11_11(2, jpkm1 )202 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 203 203 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) ) & 204 204 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 205 205 END_3D 206 DO_3D _11_11(2, jpkm1 )206 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 207 207 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), & 208 208 & 2.*ABS( zwx (ji,jj,jk+1) ), & 209 209 & 2.*ABS( zwx (ji,jj,jk ) ) ) 210 210 END_3D 211 DO_3D _00_00(1, jpk-2 )211 DO_3D( 0, 0, 0, 0, 1, jpk-2 ) 212 212 z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) ) 213 213 zalpha = 0.5 + z0w … … 219 219 IF( ln_linssh ) THEN ! top values, linear free surface only 220 220 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 221 DO_2D _11_11221 DO_2D( 1, 1, 1, 1 ) 222 222 zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 223 223 END_2D … … 227 227 ENDIF 228 228 ! 229 DO_3D _00_00(1, jpkm1 )229 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 230 230 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) & 231 231 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/traadv_qck.F90
r13237 r13295 142 142 ! 143 143 !!gm why not using a SHIFT instruction... 144 DO_3D _00_00(1, jpkm1 )144 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 145 145 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 146 146 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer … … 151 151 ! Horizontal advective fluxes 152 152 ! --------------------------- 153 DO_3D _00_00(1, jpkm1 )153 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 154 154 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 155 155 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 156 156 END_3D 157 157 ! 158 DO_3D _00_00(1, jpkm1 )158 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 159 159 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 160 160 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 170 170 ! 171 171 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 172 DO_3D _00_00(1, jpkm1 )172 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 173 173 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 174 174 END_3D … … 179 179 DO jk = 1, jpkm1 180 180 ! 181 DO_2D _00_00181 DO_2D( 0, 0, 0, 0 ) 182 182 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 183 183 !--- If the second ustream point is a land point … … 192 192 ! 193 193 ! Computation of the trend 194 DO_3D _00_00(1, jpkm1 )194 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 195 195 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 196 196 ! horizontal advective trends … … 233 233 ! 234 234 !--- Computation of the ustream and downstream value of the tracer and the mask 235 DO_2D _00_00235 DO_2D( 0, 0, 0, 0 ) 236 236 ! Upstream in the x-direction for the tracer 237 237 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) … … 247 247 ! --------------------------- 248 248 ! 249 DO_3D _00_00(1, jpkm1 )249 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 250 250 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 251 251 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 252 252 END_3D 253 253 ! 254 DO_3D _00_00(1, jpkm1 )254 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 255 255 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 256 256 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 267 267 ! 268 268 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 269 DO_3D _00_00(1, jpkm1 )269 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 270 270 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 271 271 END_3D … … 275 275 DO jk = 1, jpkm1 276 276 ! 277 DO_2D _00_00277 DO_2D( 0, 0, 0, 0 ) 278 278 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 279 279 !--- If the second ustream point is a land point … … 288 288 ! 289 289 ! Computation of the trend 290 DO_3D _00_00(1, jpkm1 )290 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 291 291 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 292 292 ! horizontal advective trends … … 327 327 ! ! =========== 328 328 ! 329 DO_3D _00_00(2, jpkm1 )329 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 330 330 zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk) 331 331 END_3D 332 332 IF( ln_linssh ) THEN !* top value (only in linear free surf. as zwz is multiplied by wmask) 333 333 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 334 DO_2D _11_11334 DO_2D( 1, 1, 1, 1 ) 335 335 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) ! linear free surface 336 336 END_2D … … 340 340 ENDIF 341 341 ! 342 DO_3D _00_00(1, jpkm1 )342 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 343 343 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 344 344 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) … … 369 369 !---------------------------------------------------------------------- 370 370 ! 371 DO_3D _11_11(1, jpkm1 )371 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 372 372 zc = puc(ji,jj,jk) ! Courant number 373 373 zcurv = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk) -
NEMO/trunk/src/OCE/TRA/traadv_ubs.F90
r13237 r13295 125 125 ! 126 126 DO jk = 1, jpkm1 !== horizontal laplacian of before tracer ==! 127 DO_2D _10_10127 DO_2D( 1, 0, 1, 0 ) 128 128 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 129 129 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) … … 131 131 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 132 132 END_2D 133 DO_2D _00_00133 DO_2D( 0, 0, 0, 0 ) 134 134 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 135 135 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef … … 140 140 CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp ) ; CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 141 141 ! 142 DO_3D _10_10(1, jpkm1 )142 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 143 143 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ! upstream transport (x2) 144 144 zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) … … 156 156 ! 157 157 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! 158 DO_2D _00_00158 DO_2D( 0, 0, 0, 0 ) 159 159 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 160 160 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & … … 188 188 ! 189 189 ! !* upstream advection with initial mass fluxes & intermediate update ==! 190 DO_3D _11_11(2, jpkm1 )190 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 191 191 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 192 192 zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) … … 195 195 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as ztw has been w-masked) 196 196 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 197 DO_2D _11_11197 DO_2D( 1, 1, 1, 1 ) 198 198 ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 199 199 END_2D … … 203 203 ENDIF 204 204 ! 205 DO_3D _00_00(1, jpkm1 )205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 206 206 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) & 207 207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) … … 212 212 ! 213 213 ! !* anti-diffusive flux : high order minus low order 214 DO_3D _11_11(2, jpkm1 )214 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 215 215 ztw(ji,jj,jk) = ( 0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 216 216 & - ztw(ji,jj,jk) ) * wmask(ji,jj,jk) … … 223 223 CASE( 4 ) ! 4th order COMPACT 224 224 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point 225 DO_3D _00_00(2, jpkm1 )225 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 226 226 ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 227 227 END_3D … … 230 230 END SELECT 231 231 ! 232 DO_3D _00_00(1, jpkm1 )232 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 233 233 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) & 234 234 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) … … 236 236 ! 237 237 IF( l_trd ) THEN ! vertical advective trend diagnostics 238 DO_3D _00_00(1, jpkm1 )238 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 239 239 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) & 240 240 & + pt(ji,jj,jk,jn,Kmm) * ( pW(ji,jj,jk) - pW(ji,jj,jk+1) ) & … … 286 286 DO jk = 1, jpkm1 ! search maximum in neighbourhood 287 287 ikm1 = MAX(jk-1,1) 288 DO_2D _00_00288 DO_2D( 0, 0, 0, 0 ) 289 289 zbetup(ji,jj,jk) = MAX( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), & 290 290 & pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), & … … 298 298 DO jk = 1, jpkm1 ! search minimum in neighbourhood 299 299 ikm1 = MAX(jk-1,1) 300 DO_2D _00_00300 DO_2D( 0, 0, 0, 0 ) 301 301 zbetdo(ji,jj,jk) = MIN( pbef(ji ,jj ,jk ), paft(ji ,jj ,jk ), & 302 302 & pbef(ji ,jj ,ikm1), pbef(ji ,jj ,jk+1), & … … 310 310 ! Positive and negative part of fluxes and beta terms 311 311 ! --------------------------------------------------- 312 DO_3D _00_00(1, jpkm1 )312 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 313 313 ! positive & negative part of the flux 314 314 zpos = MAX( 0., pcc(ji ,jj ,jk+1) ) - MIN( 0., pcc(ji ,jj ,jk ) ) … … 322 322 ! monotonic flux in the k direction, i.e. pcc 323 323 ! ------------------------------------------- 324 DO_3D _00_00(2, jpkm1 )324 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 325 325 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 326 326 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) -
NEMO/trunk/src/OCE/TRA/traatf.F90
r13237 r13295 210 210 DO jn = 1, kjpt 211 211 ! 212 DO_3D _00_00(1, jpkm1 )212 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 213 213 ztn = pt(ji,jj,jk,jn,Kmm) 214 214 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers … … 275 275 zfact2 = zfact1 * r1_rho0 276 276 DO jn = 1, kjpt 277 DO_3D _00_00(1, jpkm1 )277 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 278 278 ze3t_b = e3t(ji,jj,jk,Kbb) 279 279 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/traatf_qco.F90
r13237 r13295 203 203 DO jn = 1, kjpt 204 204 ! 205 DO_3D _00_00(1, jpkm1 )205 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 206 206 ztn = pt(ji,jj,jk,jn,Kmm) 207 207 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers … … 268 268 zfact2 = zfact1 * r1_rho0 269 269 DO jn = 1, kjpt 270 DO_3D _00_00(1, jpkm1 )270 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 271 271 ze3t_b = e3t(ji,jj,jk,Kbb) 272 272 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/trabbc.F90
r13237 r13295 91 91 ENDIF 92 92 ! ! Add the geothermal trend on temperature 93 DO_2D _00_0093 DO_2D( 0, 0, 0, 0 ) 94 94 pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) = pts(ji,jj,mbkt(ji,jj),jp_tem,Krhs) & 95 95 & + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),Kmm) -
NEMO/trunk/src/OCE/TRA/trabbl.F90
r13237 r13295 192 192 DO jn = 1, kjpt ! tracer loop 193 193 ! ! =========== 194 DO_2D _11_11194 DO_2D( 1, 1, 1, 1 ) 195 195 ik = mbkt(ji,jj) ! bottom T-level index 196 196 zptb(ji,jj) = pt(ji,jj,ik,jn) ! bottom before T and S 197 197 END_2D 198 198 ! 199 DO_2D _00_00199 DO_2D( 0, 0, 0, 0 ) 200 200 ik = mbkt(ji,jj) ! bottom T-level index 201 201 pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn) & … … 343 343 ENDIF 344 344 ! !* bottom variables (T, S, alpha, beta, depth, velocity) 345 DO_2D _11_11345 DO_2D( 1, 1, 1, 1 ) 346 346 ik = mbkt(ji,jj) ! bottom T-level index 347 347 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S … … 358 358 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 359 359 ! !-------------------! 360 DO_2D _10_10360 DO_2D( 1, 0, 1, 0 ) 361 361 ! ! i-direction 362 362 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point … … 388 388 ! 389 389 CASE( 1 ) != use of upper velocity 390 DO_2D _10_10390 DO_2D( 1, 0, 1, 0 ) 391 391 ! ! i-direction 392 392 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point … … 417 417 CASE( 2 ) != bbl velocity = F( delta rho ) 418 418 zgbbl = grav * rn_gambbl 419 DO_2D _10_10419 DO_2D( 1, 0, 1, 0 ) 420 420 ! ! i-direction 421 421 ! down-slope T-point i/k-index (deep) & up-slope T-point i/k-index (shelf) … … 509 509 ! 510 510 ! !* vertical index of "deep" bottom u- and v-points 511 DO_2D _10_10511 DO_2D( 1, 0, 1, 0 ) 512 512 mbku_d(ji,jj) = MAX( mbkt(ji+1,jj ) , mbkt(ji,jj) ) ! >= 1 as mbkt=1 over land 513 513 mbkv_d(ji,jj) = MAX( mbkt(ji ,jj+1) , mbkt(ji,jj) ) … … 520 520 ! !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 521 521 mgrhu(:,:) = 0 ; mgrhv(:,:) = 0 522 DO_2D _10_10522 DO_2D( 1, 0, 1, 0 ) 523 523 IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 524 524 mgrhu(ji,jj) = INT( SIGN( 1.0_wp, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) … … 530 530 END_2D 531 531 ! 532 DO_2D _10_10532 DO_2D( 1, 0, 1, 0 ) 533 533 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )), e3u_0(ji,jj,mbkt(ji,jj)) ) 534 534 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) -
NEMO/trunk/src/OCE/TRA/tradmp.F90
r13286 r13295 112 112 CASE( 0 ) !* newtonian damping throughout the water column *! 113 113 DO jn = 1, jpts 114 DO_3D _00_00(1, jpkm1 )114 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 115 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) … … 119 119 ! 120 120 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 121 DO_3D _00_00(1, jpkm1 )121 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 122 122 IF( avt(ji,jj,jk) <= avt_c ) THEN 123 123 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & … … 129 129 ! 130 130 CASE ( 2 ) !* no damping in the mixed layer *! 131 DO_3D _00_00(1, jpkm1 )131 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 132 132 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 133 133 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & -
NEMO/trunk/src/OCE/TRA/traisf.F90
r13237 r13295 108 108 ! 109 109 ! update pts(:,:,:,:,Krhs) 110 DO_2D _11_11110 DO_2D( 1, 1, 1, 1 ) 111 111 ! 112 112 ikt = ktop(ji,jj) -
NEMO/trunk/src/OCE/TRA/traldf_iso.F90
r13237 r13295 141 141 IF( kpass == 1 ) THEN !== first pass only ==! 142 142 ! 143 DO_3D _00_00(2, jpkm1 )143 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 144 144 ! 145 145 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 158 158 ! 159 159 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 160 DO_3D _00_00(2, jpkm1 )160 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 161 161 akz(ji,jj,jk) = 0.25_wp * ( & 162 162 & ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & … … 167 167 ! 168 168 IF( ln_traldf_blp ) THEN ! bilaplacian operator 169 DO_3D _10_10(2, jpkm1 )169 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 170 170 akz(ji,jj,jk) = 16._wp & 171 171 & * ah_wslp2 (ji,jj,jk) & … … 175 175 END_3D 176 176 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 177 DO_3D _10_10(2, jpkm1 )177 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 178 178 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 179 179 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 200 200 201 201 ! Horizontal tracer gradient 202 DO_3D _10_10(1, jpkm1 )202 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 203 203 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 204 204 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 205 205 END_3D 206 206 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 207 DO_2D _10_10207 DO_2D( 1, 0, 1, 0 ) 208 208 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 209 209 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 210 210 END_2D 211 211 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 212 DO_2D _10_10212 DO_2D( 1, 0, 1, 0 ) 213 213 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 214 214 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) … … 229 229 ELSE ; zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 230 230 ENDIF 231 DO_2D _10_10231 DO_2D( 1, 0, 1, 0 ) 232 232 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 233 233 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 250 250 END_2D 251 251 ! 252 DO_2D _00_00252 DO_2D( 0, 0, 0, 0 ) 253 253 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 254 254 & + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & … … 266 266 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 267 267 268 DO_3D _00_00(2, jpkm1 )268 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 269 269 ! 270 270 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 288 288 ! !== add the vertical 33 flux ==! 289 289 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 290 DO_3D _00_00(2, jpkm1 )290 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 291 291 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 292 292 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & … … 297 297 SELECT CASE( kpass ) 298 298 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 299 DO_3D _00_00(2, jpkm1 )299 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 300 300 ztfw(ji,jj,jk) = & 301 301 & ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & … … 303 303 END_3D 304 304 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 305 DO_3D _00_00(2, jpkm1 )305 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 306 306 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) & 307 307 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & … … 311 311 ENDIF 312 312 ! 313 DO_3D _00_00(1, jpkm1 )313 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 314 314 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) & 315 315 & / e3t(ji,jj,jk,Kmm) -
NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90
r13237 r13295 99 99 ELSE ; zsign = -1._wp 100 100 ENDIF 101 DO_3D _10_10(1, jpkm1 )101 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 102 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) !!gm * umask(ji,jj,jk) pah masked! 103 103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) !!gm * vmask(ji,jj,jk) … … 108 108 ! ! =========== ! 109 109 ! 110 DO_3D _10_10(1, jpkm1 )110 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 111 111 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) 112 112 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 113 113 END_3D 114 114 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 115 DO_2D _10_10115 DO_2D( 1, 0, 1, 0 ) 116 116 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 117 117 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 118 118 END_2D 119 119 IF( ln_isfcav ) THEN ! top in ocean cavities only 120 DO_2D _10_10120 DO_2D( 1, 0, 1, 0 ) 121 121 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 122 122 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) … … 125 125 ENDIF 126 126 ! 127 DO_3D _00_00(1, jpkm1 )127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 128 128 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 129 129 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & -
NEMO/trunk/src/OCE/TRA/traldf_triad.F90
r13237 r13295 137 137 DO ip = 0, 1 ! i-k triads 138 138 DO kp = 0, 1 139 DO_3D _10_10(1, jpkm1 )139 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 140 140 ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 141 141 zbu = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 157 157 DO jp = 0, 1 ! j-k triads 158 158 DO kp = 0, 1 159 DO_3D _10_10(1, jpkm1 )159 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 160 160 ze3wr = 1.0_wp / e3w(ji,jj+jp,jk+kp,Kmm) 161 161 zbv = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 179 179 ! 180 180 IF( ln_traldf_blp ) THEN ! bilaplacian operator 181 DO_3D _10_10(2, jpkm1 )181 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 182 182 akz(ji,jj,jk) = 16._wp & 183 183 & * ah_wslp2 (ji,jj,jk) & … … 187 187 END_3D 188 188 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 189 DO_3D _10_10(2, jpkm1 )189 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 190 190 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 191 191 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 211 211 zftv(:,:,:) = 0._wp 212 212 ! 213 DO_3D _10_10(1, jpkm1 )213 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 214 214 zdit(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 215 215 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 216 216 END_3D 217 217 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 218 DO_2D _10_10218 DO_2D( 1, 0, 1, 0 ) 219 219 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 220 220 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 221 221 END_2D 222 222 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 223 DO_2D _10_10223 DO_2D( 1, 0, 1, 0 ) 224 224 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 225 225 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) … … 246 246 DO ip = 0, 1 !== Horizontal & vertical fluxes 247 247 DO kp = 0, 1 248 DO_2D _10_10248 DO_2D( 1, 0, 1, 0 ) 249 249 ze1ur = r1_e1u(ji,jj) 250 250 zdxt = zdit(ji,jj,jk) * ze1ur … … 267 267 DO jp = 0, 1 268 268 DO kp = 0, 1 269 DO_2D _10_10269 DO_2D( 1, 0, 1, 0 ) 270 270 ze2vr = r1_e2v(ji,jj) 271 271 zdyt = zdjt(ji,jj,jk) * ze2vr … … 289 289 DO ip = 0, 1 !== Horizontal & vertical fluxes 290 290 DO kp = 0, 1 291 DO_2D _10_10291 DO_2D( 1, 0, 1, 0 ) 292 292 ze1ur = r1_e1u(ji,jj) 293 293 zdxt = zdit(ji,jj,jk) * ze1ur … … 310 310 DO jp = 0, 1 311 311 DO kp = 0, 1 312 DO_2D _10_10312 DO_2D( 1, 0, 1, 0 ) 313 313 ze2vr = r1_e2v(ji,jj) 314 314 zdyt = zdjt(ji,jj,jk) * ze2vr … … 329 329 ENDIF 330 330 ! !== horizontal divergence and add to the general trend ==! 331 DO_2D _00_00331 DO_2D( 0, 0, 0, 0 ) 332 332 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 333 333 & + zsign * ( zftu(ji-1,jj ,jk) - zftu(ji,jj,jk) & … … 340 340 ! !== add the vertical 33 flux ==! 341 341 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 342 DO_3D _10_00(2, jpkm1 )342 DO_3D( 1, 0, 0, 0, 2, jpkm1 ) 343 343 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 344 344 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & … … 348 348 SELECT CASE( kpass ) 349 349 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 350 DO_3D _10_00(2, jpkm1 )350 DO_3D( 1, 0, 0, 0, 2, jpkm1 ) 351 351 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 352 352 & * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 353 353 END_3D 354 354 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt and pt2 gradients, resp. 355 DO_3D _10_00(2, jpkm1 )355 DO_3D( 1, 0, 0, 0, 2, jpkm1 ) 356 356 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk) & 357 357 & * ( ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) ) & … … 361 361 ENDIF 362 362 ! 363 DO_3D _00_00(1, jpkm1 )363 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 364 364 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) & 365 365 & + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & -
NEMO/trunk/src/OCE/TRA/tramle.F90
r13237 r13295 100 100 inml_mle(:,:) = mbkt(:,:) + 1 ! init. to number of ocean w-level (T-level + 1) 101 101 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 102 DO_3DS _11_11(jpkm1, nlb10, -1 )102 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 103 103 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle ) inml_mle(ji,jj) = jk ! Mixed layer 104 104 END_3D … … 110 110 zbm (:,:) = 0._wp 111 111 zn2 (:,:) = 0._wp 112 DO_3D _11_11(1, ikmax )112 DO_3D( 1, 1, 1, 1, 1, ikmax ) 113 113 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 114 114 zmld(ji,jj) = zmld(ji,jj) + zc … … 119 119 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 120 120 CASE ( 0 ) != min of the 2 neighbour MLDs 121 DO_2D _10_10121 DO_2D( 1, 0, 1, 0 ) 122 122 zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 123 123 zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 124 124 END_2D 125 125 CASE ( 1 ) != average of the 2 neighbour MLDs 126 DO_2D _10_10126 DO_2D( 1, 0, 1, 0 ) 127 127 zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 128 128 zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 129 129 END_2D 130 130 CASE ( 2 ) != max of the 2 neighbour MLDs 131 DO_2D _10_10131 DO_2D( 1, 0, 1, 0 ) 132 132 zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 133 133 zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) … … 146 146 ! 147 147 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 148 DO_2D _10_10148 DO_2D( 1, 0, 1, 0 ) 149 149 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 150 150 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) & … … 157 157 ! 158 158 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 159 DO_2D _10_10159 DO_2D( 1, 0, 1, 0 ) 160 160 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 161 161 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) … … 167 167 ! 168 168 IF( nn_conv == 1 ) THEN ! No MLE in case of convection 169 DO_2D _10_10169 DO_2D( 1, 0, 1, 0 ) 170 170 IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp ) zpsim_u(ji,jj) = 0._wp 171 171 IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp ) zpsim_v(ji,jj) = 0._wp … … 174 174 ! 175 175 ! !== structure function value at uw- and vw-points ==! 176 DO_2D _10_10176 DO_2D( 1, 0, 1, 0 ) 177 177 zhu(ji,jj) = 1._wp / zhu(ji,jj) ! hu --> 1/hu 178 178 zhv(ji,jj) = 1._wp / zhv(ji,jj) … … 182 182 zpsi_vw(:,:,:) = 0._wp 183 183 ! 184 DO_3D _10_10(2, ikmax )184 DO_3D( 1, 0, 1, 0, 2, ikmax ) 185 185 zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 186 186 zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) … … 196 196 ! !== transport increased by the MLE induced transport ==! 197 197 DO jk = 1, ikmax 198 DO_2D _10_10198 DO_2D( 1, 0, 1, 0 ) 199 199 pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 200 200 pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 201 201 END_2D 202 DO_2D _00_00202 DO_2D( 0, 0, 0, 0 ) 203 203 pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk) & 204 204 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) … … 283 283 IF( ierr /= 0 ) CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 284 284 z1_t2 = 1._wp / ( rn_time * rn_time ) 285 DO_2D _01_01285 DO_2D( 0, 1, 0, 1 ) 286 286 zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 287 287 zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp -
NEMO/trunk/src/OCE/TRA/tranpc.F90
r13237 r13295 103 103 inpcc = 0 104 104 ! 105 DO_2D _00_00105 DO_2D( 0, 0, 0, 0 ) 106 106 ! 107 107 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points -
NEMO/trunk/src/OCE/TRA/traqsr.F90
r13286 r13295 172 172 ! most expensive calculations) 173 173 ! 174 DO_2D _00_00174 DO_2D( 0, 0, 0, 0 ) 175 175 ! zlogc = log(zchl) 176 176 zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) … … 191 191 192 192 ! 193 DO_3D _00_00 (1, nksr + 1 )193 DO_3D( 0, 0, 0, 0, 1, nksr + 1 ) 194 194 ! zchl = ALOG( ze0(ji,jj) ) 195 195 zlogc = ze0(ji,jj) … … 221 221 ! 222 222 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 223 DO_2D _00_00223 DO_2D( 0, 0, 0, 0 ) 224 224 ze0(ji,jj) = rn_abs * qsr(ji,jj) 225 225 ze1(ji,jj) = zcoef * qsr(ji,jj) … … 232 232 ! 233 233 !* interior equi-partition in R-G-B depending on vertical profile of Chl 234 DO_3D _00_00 (2, nksr + 1 )234 DO_3D( 0, 0, 0, 0, 2, nksr + 1 ) 235 235 ze3t = e3t(ji,jj,jk-1,Kmm) 236 236 irgb = NINT( ztmp3d(ji,jj,jk) ) … … 246 246 END_3D 247 247 ! 248 DO_3D _00_00(1, nksr )248 DO_3D( 0, 0, 0, 0, 1, nksr ) 249 249 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 250 250 END_3D … … 256 256 zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands 257 257 zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 258 DO_3D _00_00(1, nksr )258 DO_3D( 0, 0, 0, 0, 1, nksr ) 259 259 zc0 = zz0 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi1r ) 260 260 zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) … … 265 265 ! 266 266 ! !-----------------------------! 267 DO_3D _00_00(1, nksr )267 DO_3D( 0, 0, 0, 0, 1, nksr ) 268 268 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 269 269 & + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) & … … 272 272 ! 273 273 ! sea-ice: store the 1st ocean level attenuation coefficient 274 DO_2D _00_00274 DO_2D( 0, 0, 0, 0 ) 275 275 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 276 276 ELSE ; fraqsr_1lev(ji,jj) = 1._wp -
NEMO/trunk/src/OCE/TRA/trasbc.F90
r13286 r13295 124 124 ENDIF 125 125 ! !== Now sbc tracer content fields ==! 126 DO_2D _01_00126 DO_2D( 0, 1, 0, 0 ) 127 127 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 128 128 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 129 129 END_2D 130 130 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D _01_00131 DO_2D( 0, 1, 0, 0 ) 132 132 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 133 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) … … 138 138 ! 139 139 DO jn = 1, jpts !== update tracer trend ==! 140 DO_2D _01_00140 DO_2D( 0, 1, 0, 0 ) 141 141 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & 142 142 & / e3t(ji,jj,1,Kmm) … … 157 157 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 158 158 zfact = 0.5_wp 159 DO_2D _01_00159 DO_2D( 0, 1, 0, 0 ) 160 160 IF( rnf(ji,jj) /= 0._wp ) THEN 161 161 zdep = zfact / h_rnf(ji,jj) … … 182 182 ! 183 183 IF( ln_linssh ) THEN 184 DO_2D _01_00184 DO_2D( 0, 1, 0, 0 ) 185 185 ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 186 186 pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim … … 188 188 END_2D 189 189 ELSE 190 DO_2D _01_00190 DO_2D( 0, 1, 0, 0 ) 191 191 ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) ) 192 192 pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim -
NEMO/trunk/src/OCE/TRA/trazdf.F90
r13237 r13295 161 161 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 162 162 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 163 DO_3D _00_00(2, jpkm1 )163 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 164 164 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 165 165 END_3D 166 166 ELSE ! standard or triad iso-neutral operator 167 DO_3D _00_00(2, jpkm1 )167 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 168 168 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 169 169 END_3D … … 173 173 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 174 174 IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection 175 DO_3D _00_00(1, jpkm1 )175 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 176 176 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 177 177 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) … … 182 182 END_3D 183 183 ELSE 184 DO_3D _00_00(1, jpkm1 )184 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 185 185 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 186 186 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) … … 208 208 ! used as a work space array: its value is modified. 209 209 ! 210 DO_2D _00_00210 DO_2D( 0, 0, 0, 0 ) 211 211 zwt(ji,jj,1) = zwd(ji,jj,1) 212 212 END_2D 213 DO_3D _00_00(2, jpkm1 )213 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 214 214 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 215 215 END_3D … … 217 217 ENDIF 218 218 ! 219 DO_2D _00_00219 DO_2D( 0, 0, 0, 0 ) 220 220 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) & 221 221 & + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 222 222 END_2D 223 DO_3D _00_00(2, jpkm1 )223 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 224 224 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) & 225 225 & + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side … … 227 227 END_3D 228 228 ! 229 DO_2D _00_00229 DO_2D( 0, 0, 0, 0 ) 230 230 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 231 231 END_2D 232 DO_3DS _00_00(jpk-2, 1, -1 )232 DO_3DS( 0, 0, 0, 0, jpk-2, 1, -1 ) 233 233 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 234 234 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) -
NEMO/trunk/src/OCE/TRA/zpshde.F90
r13237 r13295 107 107 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 108 108 ! 109 DO_2D _10_10109 DO_2D( 1, 0, 1, 0 ) 110 110 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 111 111 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 151 151 pgru(:,:) = 0._wp 152 152 pgrv(:,:) = 0._wp ! depth of the partial step level 153 DO_2D _10_10153 DO_2D( 1, 0, 1, 0 ) 154 154 iku = mbku(ji,jj) 155 155 ikv = mbkv(ji,jj) … … 167 167 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 168 168 ! 169 DO_2D _10_10169 DO_2D( 1, 0, 1, 0 ) 170 170 iku = mbku(ji,jj) 171 171 ikv = mbkv(ji,jj) … … 262 262 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 263 263 ! 264 DO_2D _10_10264 DO_2D( 1, 0, 1, 0 ) 265 265 266 266 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points … … 308 308 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 309 309 ! 310 DO_2D _10_10310 DO_2D( 1, 0, 1, 0 ) 311 311 312 312 iku = mbku(ji,jj) … … 329 329 CALL eos( ztj, zhj, zrj ) 330 330 331 DO_2D _10_10331 DO_2D( 1, 0, 1, 0 ) 332 332 iku = mbku(ji,jj) 333 333 ikv = mbkv(ji,jj) … … 351 351 ! 352 352 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 353 DO_2D _10_10353 DO_2D( 1, 0, 1, 0 ) 354 354 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 355 355 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 … … 400 400 ! 401 401 pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; 402 DO_2D _10_10402 DO_2D( 1, 0, 1, 0 ) 403 403 404 404 iku = miku(ji,jj) … … 420 420 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 421 421 ! 422 DO_2D _10_10422 DO_2D( 1, 0, 1, 0 ) 423 423 iku = miku(ji,jj) 424 424 ikv = mikv(ji,jj) -
NEMO/trunk/src/OCE/TRD/trddyn.F90
r13237 r13295 124 124 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 125 125 z3dy(:,:,:) = 0._wp 126 DO_3D _00_00(1, jpkm1 )126 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 127 127 z3dx(ji,jj,jk) = uu(ji,jj,jk,Kmm) * ( uu(ji+1,jj,jk,Kmm) - uu(ji-1,jj,jk,Kmm) ) / ( 2._wp * e1u(ji,jj) ) 128 128 z3dy(ji,jj,jk) = vv(ji,jj,jk,Kmm) * ( vv(ji,jj+1,jk,Kmm) - vv(ji,jj-1,jk,Kmm) ) / ( 2._wp * e2v(ji,jj) ) -
NEMO/trunk/src/OCE/TRD/trdglo.F90
r13237 r13295 86 86 ! 87 87 CASE( 'TRA' ) !== Tracers (T & S) ==! 88 DO_3D _11_11(1, jpkm1 )88 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 89 89 zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 90 90 zvt = ptrdx(ji,jj,jk) * zvm … … 115 115 ! 116 116 CASE( 'DYN' ) !== Momentum and KE ==! 117 DO_3D _10_10(1, jpkm1 )117 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 118 118 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 119 119 & * e1e2u (ji,jj) * e3u(ji,jj,jk,Kmm) … … 127 127 IF( ktrd == jpdyn_zdf ) THEN ! zdf trend: compute separately the surface forcing trend 128 128 z1_2rho0 = 0.5_wp / rho0 129 DO_2D _10_10129 DO_2D( 1, 0, 1, 0 ) 130 130 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 131 131 & * z1_2rho0 * e1e2u(ji,jj) … … 211 211 212 212 zcof = 0.5_wp / rho0 ! Density flux at u and v-points 213 DO_3D _10_10(1, jpkm1 )213 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 214 214 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) & 215 215 & * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) … … 218 218 END_3D 219 219 220 DO_3D _00_00(1, jpkm1 )220 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 221 221 zkepe(ji,jj,jk) = - ( zkz(ji,jj,jk) - zkz(ji ,jj ,jk+1) & 222 222 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & … … 527 527 tvolv = 0._wp 528 528 529 DO_3D _00_00(1, jpk )529 DO_3D( 0, 0, 0, 0, 1, jpk ) 530 530 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) & 531 531 & * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) -
NEMO/trunk/src/OCE/TRD/trdken.F90
r13237 r13295 102 102 zke(1,:, : ) = 0._wp 103 103 zke(:,1, : ) = 0._wp 104 DO_3D _01_01(1, jpkm1 )104 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 105 105 zke(ji,jj,jk) = 0.5_wp * rho0 *( uu(ji ,jj,jk,Kmm) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) & 106 106 & + uu(ji-1,jj,jk,Kmm) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & … … 123 123 z2dy(:,:) = vv(:,:,1,Kmm) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 124 124 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 125 DO_2D _01_01125 DO_2D( 0, 1, 0, 1 ) 126 126 zke2d(ji,jj) = r1_rho0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 127 127 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) … … 219 219 220 220 ! conv value on T-point 221 DO_3D _11_11(1, jpkm1 )221 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 222 222 zcoef = 0.5_wp / e3t(ji,jj,jk,Kmm) 223 223 pconv(ji,jj,jk) = zcoef * ( zconv(ji,jj,jk) + zconv(ji,jj,jk+1) ) * tmask(ji,jj,jk) -
NEMO/trunk/src/OCE/TRD/trdmxl.F90
r13237 r13295 120 120 ! 121 121 wkx(:,:,:) = 0._wp !== now ML weights for vertical averaging ==! 122 DO_3D _11_11(1, jpktrd )122 DO_3D( 1, 1, 1, 1, 1, jpktrd ) 123 123 IF( jk - kmxln(ji,jj) < 0 ) THEN 124 124 wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) -
NEMO/trunk/src/OCE/TRD/trdtra.F90
r13237 r13295 221 221 ptrd(:,:,jpk) = 0._wp 222 222 ! 223 DO_3D _00_00(1, jpkm1 )223 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 224 224 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 225 225 & - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk) ) & -
NEMO/trunk/src/OCE/TRD/trdvor.F90
r13237 r13295 105 105 CASE( jpdyn_zdf ) ! Vertical Diffusion 106 106 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 107 DO_2D _00_00107 DO_2D( 0, 0, 0, 0 ) 108 108 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 ) 109 109 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 ) … … 172 172 ! 173 173 CASE( jpvor_bfr ) ! bottom friction 174 DO_2D _00_00174 DO_2D( 0, 0, 0, 0 ) 175 175 ikbu = mbkv(ji,jj) 176 176 ikbv = mbkv(ji,jj) -
NEMO/trunk/src/OCE/USR/usrdef_hgr.F90
r13286 r13295 115 115 ENDIF 116 116 ! 117 DO_2D _11_11117 DO_2D( 1, 1, 1, 1 ) 118 118 zim1 = REAL( mig0_oldcmp(ji), wp ) - 1. ; zim05 = REAL( mig0_oldcmp(ji), wp ) - 1.5 119 119 zjm1 = REAL( mjg0_oldcmp(jj), wp ) - 1. ; zjm05 = REAL( mjg0_oldcmp(jj), wp ) - 1.5 -
NEMO/trunk/src/OCE/USR/usrdef_istate.F90
r12377 r13295 61 61 pssh(:,:) = 0._wp 62 62 ! 63 DO_3D _11_11(1, jpk )63 DO_3D( 1, 1, 1, 1, 1, jpk ) 64 64 pts(ji,jj,jk,jp_tem) = ( ( 16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) ) & 65 65 & * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2. & -
NEMO/trunk/src/OCE/USR/usrdef_sbc.F90
r13226 r13295 110 110 ztrp= - 40.e0 ! retroaction term on heat fluxes (W/m2/K) 111 111 zconv = 3.16e-5 ! convertion factor: 1 m/yr => 3.16e-5 mm/s 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 ! domain from 15 deg to 50 deg between 27 and 28 degC at 15N, -3 114 114 ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period : … … 165 165 ztau_sais = 0.015 166 166 ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 167 DO_2D _11_11167 DO_2D( 1, 1, 1, 1 ) 168 168 ! domain from 15deg to 50deg and 1/2 period along 14deg 169 169 ! so 5/4 of half period with seasonal cycle … … 174 174 ! module of wind stress and wind speed at T-point 175 175 zcoef = 1. / ( zrhoa * zcdrag ) 176 DO_2D _00_00176 DO_2D( 0, 0, 0, 0 ) 177 177 ztx = utau(ji-1,jj ) + utau(ji,jj) 178 178 zty = vtau(ji ,jj-1) + vtau(ji,jj) -
NEMO/trunk/src/OCE/ZDF/zdfddm.F90
r13237 r13295 94 94 !!gm and many acces in memory 95 95 96 DO_2D _11_1196 DO_2D( 1, 1, 1, 1 ) 97 97 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 98 98 !!gm please, use e3w at Kmm below … … 110 110 END_2D 111 111 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 114 114 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp … … 140 140 ! ------------------ 141 141 ! Constant eddy coefficient: reset to the background value 142 DO_2D _11_11142 DO_2D( 1, 1, 1, 1 ) 143 143 zinr = 1._wp / zrau(ji,jj) 144 144 ! salt fingering -
NEMO/trunk/src/OCE/ZDF/zdfdrg.F90
r13286 r13295 116 116 ! 117 117 IF( l_log_not_linssh ) THEN !== "log layer" ==! compute Cd and -Cd*|U| 118 DO_2D _00_00118 DO_2D( 0, 0, 0, 0 ) 119 119 imk = k_mk(ji,jj) ! ocean bottom level at t-points 120 120 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point … … 128 128 END_2D 129 129 ELSE !== standard Cd ==! 130 DO_2D _00_00130 DO_2D( 0, 0, 0, 0 ) 131 131 imk = k_mk(ji,jj) ! ocean bottom level at t-points 132 132 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point … … 175 175 ENDIF 176 176 177 DO_2D _00_00177 DO_2D( 0, 0, 0, 0 ) 178 178 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 179 179 ikbv = mbkv(ji,jj) … … 188 188 ! 189 189 IF( ln_isfcav ) THEN ! ocean cavities 190 DO_2D _00_00190 DO_2D( 0, 0, 0, 0 ) 191 191 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 192 192 ikbv = mikv(ji,jj) … … 422 422 l_log_not_linssh = .FALSE. !- don't update Cd at each time step 423 423 ! 424 DO_2D _11_11424 DO_2D( 1, 1, 1, 1 ) 425 425 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 426 426 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 -
NEMO/trunk/src/OCE/ZDF/zdfevd.F90
r12377 r13295 87 87 ! END WHERE 88 88 ! 89 DO_3D _00_00(1, jpkm1 )89 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 90 90 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 91 91 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) … … 103 103 ! END WHERE 104 104 105 DO_3D _00_00(1, jpkm1 )105 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 106 106 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 107 107 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) -
NEMO/trunk/src/OCE/ZDF/zdfgls.F90
r13286 r13295 168 168 169 169 ! Compute surface, top and bottom friction at T-points 170 DO_2D _00_00170 DO_2D( 0, 0, 0, 0 ) 171 171 ! 172 172 ! surface friction … … 181 181 END_2D 182 182 IF( ln_isfcav ) THEN !top friction 183 DO_2D _00_00183 DO_2D( 0, 0, 0, 0 ) 184 184 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 185 185 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) … … 204 204 END SELECT 205 205 ! 206 DO_3D _10_10(2, jpkm1 )206 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 207 207 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 208 208 END_3D … … 213 213 214 214 IF( nn_clos == 0 ) THEN ! Mellor-Yamada 215 DO_3D _00_00(2, jpkm1 )215 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 216 216 zup = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 217 217 zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) … … 234 234 ! Warning : after this step, en : right hand side of the matrix 235 235 236 DO_3D _00_00(2, jpkm1 )236 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 237 237 ! 238 238 buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk) ! stratif. destruction … … 330 330 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 331 331 ! ! Balance between the production and the dissipation terms 332 DO_2D _00_00332 DO_2D( 0, 0, 0, 0 ) 333 333 !!gm This means that bottom and ocean w-level above have a specified "en" value. Sure ???? 334 334 !! With thick deep ocean level thickness, this may be quite large, no ??? … … 348 348 ! 349 349 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 350 DO_2D _00_00350 DO_2D( 0, 0, 0, 0 ) 351 351 itop = mikt(ji,jj) ! k top w-point 352 352 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one … … 366 366 CASE ( 1 ) ! Neumman boundary condition 367 367 ! 368 DO_2D _00_00368 DO_2D( 0, 0, 0, 0 ) 369 369 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 370 370 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 … … 380 380 END_2D 381 381 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 382 DO_2D _00_00382 DO_2D( 0, 0, 0, 0 ) 383 383 itop = mikt(ji,jj) ! k top w-point 384 384 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one … … 400 400 ! ---------------------------------------------------------- 401 401 ! 402 DO_3D _00_00(2, jpkm1 )402 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 403 403 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 404 404 END_3D 405 DO_3D _00_00(2, jpk )405 DO_3D( 0, 0, 0, 0, 2, jpk ) 406 406 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 407 407 END_3D 408 DO_3DS _00_00(jpk-1, 2, -1 )408 DO_3DS( 0, 0, 0, 0, jpk-1, 2, -1 ) 409 409 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 410 410 END_3D … … 421 421 ! 422 422 CASE( 0 ) ! k-kl (Mellor-Yamada) 423 DO_3D _00_00(2, jpkm1 )423 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 424 424 psi(ji,jj,jk) = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 425 425 END_3D 426 426 ! 427 427 CASE( 1 ) ! k-eps 428 DO_3D _00_00(2, jpkm1 )428 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 429 429 psi(ji,jj,jk) = eps(ji,jj,jk) 430 430 END_3D 431 431 ! 432 432 CASE( 2 ) ! k-w 433 DO_3D _00_00(2, jpkm1 )433 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 434 434 psi(ji,jj,jk) = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 435 435 END_3D 436 436 ! 437 437 CASE( 3 ) ! generic 438 DO_3D _00_00(2, jpkm1 )438 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 439 439 psi(ji,jj,jk) = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 440 440 END_3D … … 449 449 ! Warning : after this step, en : right hand side of the matrix 450 450 451 DO_3D _00_00(2, jpkm1 )451 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 452 452 ! 453 453 ! psi / k … … 546 546 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 547 547 ! ! Balance between the production and the dissipation terms 548 DO_2D _00_00548 DO_2D( 0, 0, 0, 0 ) 549 549 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 550 550 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 … … 565 565 CASE ( 1 ) ! Neumman boundary condition 566 566 ! 567 DO_2D _00_00567 DO_2D( 0, 0, 0, 0 ) 568 568 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 569 569 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 … … 593 593 ! ---------------- 594 594 ! 595 DO_3D _00_00(2, jpkm1 )595 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 596 596 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 597 597 END_3D 598 DO_3D _00_00(2, jpk )598 DO_3D( 0, 0, 0, 0, 2, jpk ) 599 599 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 600 600 END_3D 601 DO_3DS _00_00(jpk-1, 2, -1 )601 DO_3DS( 0, 0, 0, 0, jpk-1, 2, -1 ) 602 602 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 603 603 END_3D … … 609 609 ! 610 610 CASE( 0 ) ! k-kl (Mellor-Yamada) 611 DO_3D _00_00(1, jpkm1 )611 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 612 612 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 613 613 END_3D 614 614 ! 615 615 CASE( 1 ) ! k-eps 616 DO_3D _00_00(1, jpkm1 )616 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 617 617 eps(ji,jj,jk) = psi(ji,jj,jk) 618 618 END_3D 619 619 ! 620 620 CASE( 2 ) ! k-w 621 DO_3D _00_00(1, jpkm1 )621 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 622 622 eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 623 623 END_3D … … 627 627 zex1 = ( 1.5_wp + rmm/rnn ) 628 628 zex2 = -1._wp / rnn 629 DO_3D _00_00(1, jpkm1 )629 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 630 630 eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 631 631 END_3D … … 635 635 ! Limit dissipation rate under stable stratification 636 636 ! -------------------------------------------------- 637 DO_3D _00_00(1, jpkm1 )637 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 638 638 ! limitation 639 639 eps (ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin ) … … 651 651 ! 652 652 CASE ( 0 , 1 ) ! Galperin or Kantha-Clayson stability functions 653 DO_3D _00_00(2, jpkm1 )653 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 654 654 ! zcof = l²/q² 655 655 zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) … … 668 668 ! 669 669 CASE ( 2, 3 ) ! Canuto stability functions 670 DO_3D _00_00(2, jpkm1 )670 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 671 671 ! zcof = l²/q² 672 672 zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) … … 700 700 ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 701 701 zstm(:,:,jpk) = 0. 702 DO_2D _00_00702 DO_2D( 0, 0, 0, 0 ) 703 703 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 704 704 END_2D … … 715 715 ! later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 716 716 ! for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 717 DO_3D _00_00(1, jpk )717 DO_3D( 0, 0, 0, 0, 1, jpk ) 718 718 zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 719 719 zavt = zsqen * zstt(ji,jj,jk) -
NEMO/trunk/src/OCE/ZDF/zdfiwm.F90
r13286 r13295 143 143 ! Set to zero the 1st and last vertical levels of appropriate variables 144 144 IF( iom_use("emix_iwm") ) THEN 145 DO_2D _00_00145 DO_2D( 0, 0, 0, 0 ) 146 146 zemx_iwm (ji,jj,1) = 0._wp ; zemx_iwm (ji,jj,jpk) = 0._wp 147 147 END_2D … … 150 150 ENDIF 151 151 IF( iom_use("av_ratio") ) THEN 152 DO_2D _00_00152 DO_2D( 0, 0, 0, 0 ) 153 153 zav_ratio(ji,jj,1) = 0._wp ; zav_ratio(ji,jj,jpk) = 0._wp 154 154 END_2D … … 157 157 ENDIF 158 158 IF( iom_use("av_wave") ) THEN 159 DO_2D _00_00159 DO_2D( 0, 0, 0, 0 ) 160 160 zav_wave (ji,jj,1) = 0._wp ; zav_wave (ji,jj,jpk) = 0._wp 161 161 END_2D … … 170 170 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 171 171 ! using an exponential decay from the seafloor. 172 DO_2D _00_00172 DO_2D( 0, 0, 0, 0 ) 173 173 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 174 174 zfact(ji,jj) = rho0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) … … 176 176 END_2D 177 177 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 178 DO_3D _00_00(2, jpkm1 )178 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 179 179 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 180 180 zemx_iwm(ji,jj,jk) = 0._wp … … 196 196 CASE ( 1 ) ! Dissipation scales as N (recommended) 197 197 ! 198 DO_2D _00_00198 DO_2D( 0, 0, 0, 0 ) 199 199 zfact(ji,jj) = 0._wp 200 200 END_2D 201 DO_3D _00_00(2, jpkm1 ) ! part independent of the level201 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 202 202 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 203 203 END_3D 204 204 ! 205 DO_2D _00_00205 DO_2D( 0, 0, 0, 0 ) 206 206 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 207 207 END_2D 208 208 ! 209 DO_3D _00_00(2, jpkm1 ) ! complete with the level-dependent part209 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 210 210 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 211 211 END_3D … … 213 213 CASE ( 2 ) ! Dissipation scales as N^2 214 214 ! 215 DO_2D _00_00215 DO_2D( 0, 0, 0, 0 ) 216 216 zfact(ji,jj) = 0._wp 217 217 END_2D 218 DO_3D _00_00(2, jpkm1 ) ! part independent of the level218 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 219 219 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 220 220 END_3D 221 221 ! 222 DO_2D _00_00222 DO_2D( 0, 0, 0, 0 ) 223 223 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 224 224 END_2D 225 225 ! 226 DO_3D _00_00(2, jpkm1 ) ! complete with the level-dependent part226 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 227 227 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 228 228 END_3D … … 233 233 ! !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 234 234 ! 235 DO_2D _00_00235 DO_2D( 0, 0, 0, 0 ) 236 236 zwkb(ji,jj,1) = 0._wp 237 237 END_2D 238 DO_3D _00_00(2, jpkm1 )238 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 239 239 zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 240 240 END_3D 241 DO_2D _00_00241 DO_2D( 0, 0, 0, 0 ) 242 242 zfact(ji,jj) = zwkb(ji,jj,jpkm1) 243 243 END_2D 244 244 ! 245 DO_3D _00_00(2, jpkm1 )245 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 246 246 IF( zfact(ji,jj) /= 0 ) zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) ) & 247 247 & * wmask(ji,jj,jk) / zfact(ji,jj) 248 248 END_3D 249 DO_2D _00_00249 DO_2D( 0, 0, 0, 0 ) 250 250 zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 251 251 END_2D 252 252 ! 253 DO_3D _00_00(2, jpkm1 )253 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 254 254 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization: EXP coast a lot 255 255 zweight(ji,jj,jk) = 0._wp … … 260 260 END_3D 261 261 ! 262 DO_2D _00_00262 DO_2D( 0, 0, 0, 0 ) 263 263 zfact(ji,jj) = 0._wp 264 264 END_2D 265 DO_3D _00_00(2, jpkm1 ) ! part independent of the level265 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 266 266 zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 267 267 END_3D 268 268 ! 269 DO_2D _00_00269 DO_2D( 0, 0, 0, 0 ) 270 270 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 271 271 END_2D 272 272 ! 273 DO_3D _00_00(2, jpkm1 ) ! complete with the level-dependent part273 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 274 274 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk) & 275 275 & / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) … … 279 279 !!gm this is to be replaced by just a constant value znu=1.e-6 m2/s 280 280 ! Calculate molecular kinematic viscosity 281 DO_3D _00_00(1, jpkm1 )281 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 282 282 znu_t(ji,jj,jk) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm) & 283 283 & + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) & 284 284 & + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm) ) * tmask(ji,jj,jk) * r1_rho0 285 285 END_3D 286 DO_3D _00_00(2, jpkm1 )286 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 287 287 znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 288 288 END_3D … … 290 290 ! 291 291 ! Calculate turbulence intensity parameter Reb 292 DO_3D _00_00(2, jpkm1 )292 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 293 293 zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 294 294 END_3D 295 295 ! 296 296 ! Define internal wave-induced diffusivity 297 DO_3D _00_00(2, jpkm1 )297 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 298 298 zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 299 299 END_3D 300 300 ! 301 301 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 302 DO_3D _00_00(2, jpkm1 )302 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 303 303 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 304 304 zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) … … 309 309 ENDIF 310 310 ! 311 DO_3D _00_00(2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s311 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 312 312 zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk) 313 313 END_3D … … 316 316 zztmp = 0._wp 317 317 !!gm used of glosum 3D.... 318 DO_3D _00_00(2, jpkm1 )318 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 319 319 zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj) & 320 320 & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) … … 338 338 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 339 339 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 340 DO_3D _00_00(2, jpkm1 )340 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 341 341 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 342 342 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN … … 347 347 END_3D 348 348 CALL iom_put( "av_ratio", zav_ratio ) 349 DO_3D _00_00(2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing349 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing 350 350 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 351 351 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) … … 354 354 ! 355 355 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 356 DO_3D _00_00(2, jpkm1 )356 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 357 357 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 358 358 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) … … 369 369 ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 370 370 ! Initialisation for iom_put 371 DO_2D _00_00371 DO_2D( 0, 0, 0, 0 ) 372 372 z3d(ji,jj,1) = 0._wp ; z3d(ji,jj,jpk) = 0._wp 373 373 END_2D … … 377 377 z2d(jpi-nn_hls+1:jpi ,: ) = 0._wp ; z2d(:,jpj-nn_hls+1: jpj ) = 0._wp 378 378 379 DO_3D _00_00(2, jpkm1 )379 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 380 380 z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 381 381 END_3D 382 DO_2D _00_00382 DO_2D( 0, 0, 0, 0 ) 383 383 z2d(ji,jj) = 0._wp 384 384 END_2D 385 DO_3D _00_00(2, jpkm1 )385 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 386 386 z2d(ji,jj) = z2d(ji,jj) + e3w(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * wmask(ji,jj,jk) 387 387 END_3D 388 DO_2D _00_00388 DO_2D( 0, 0, 0, 0 ) 389 389 z2d(ji,jj) = rho0 * z2d(ji,jj) 390 390 END_2D -
NEMO/trunk/src/OCE/ZDF/zdfmxl.F90
r13237 r13295 99 99 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 100 100 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 101 DO_3D _11_11(nlb10, jpkm1 )101 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 102 102 ikt = mbkt(ji,jj) 103 103 hmlp(ji,jj) = & … … 108 108 ! w-level of the turbocline and mixing layer (iom_use) 109 109 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 110 DO_3DS _11_11(jpkm1, nlb10, -1 )110 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) 111 111 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 112 112 END_3D 113 113 ! depth of the mixing and mixed layers 114 DO_2D _11_11114 DO_2D( 1, 1, 1, 1 ) 115 115 iiki = imld(ji,jj) 116 116 iikn = nmln(ji,jj) -
NEMO/trunk/src/OCE/ZDF/zdfosm.F90
r13286 r13295 300 300 zz0 = rn_abs ! surface equi-partition in 2-bands 301 301 zz1 = 1. - rn_abs 302 DO_2D _00_00302 DO_2D( 0, 0, 0, 0 ) 303 303 ! Surface downward irradiance (so always +ve) 304 304 zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp … … 310 310 END_2D 311 311 ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 312 DO_2D _00_00312 DO_2D( 0, 0, 0, 0 ) 313 313 zthermal = rab_n(ji,jj,1,jp_tem) 314 314 zbeta = rab_n(ji,jj,1,jp_sal) … … 337 337 ! Assume constant La#=0.3 338 338 CASE(0) 339 DO_2D _00_00339 DO_2D( 0, 0, 0, 0 ) 340 340 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 341 341 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 … … 345 345 ! Assume Pierson-Moskovitz wind-wave spectrum 346 346 CASE(1) 347 DO_2D _00_00347 DO_2D( 0, 0, 0, 0 ) 348 348 ! Use wind speed wndm included in sbc_oce module 349 349 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) … … 353 353 CASE(2) 354 354 zfac = 2.0_wp * rpi / 16.0_wp 355 DO_2D _00_00355 DO_2D( 0, 0, 0, 0 ) 356 356 ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 357 357 ! The coefficient 0.8 gives La=0.3 in this situation. … … 366 366 ! Langmuir velocity scale (zwstrl), La # (zla) 367 367 ! mixed scale (zvstr), convective velocity scale (zwstrc) 368 DO_2D _00_00368 DO_2D( 0, 0, 0, 0 ) 369 369 ! Langmuir velocity scale (zwstrl), at T-point 370 370 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird … … 402 402 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,3,Kmm) ) 403 403 ibld(:,:) = 3 404 DO_3D _00_00(4, jpkm1 )404 DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 405 405 IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 406 406 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) … … 408 408 END_3D 409 409 410 DO_2D _00_00410 DO_2D( 0, 0, 0, 0 ) 411 411 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 412 412 zbeta = rab_n(ji,jj,1,jp_sal) … … 478 478 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 479 479 480 DO_3D _00_00(4, jpkm1 )480 DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 481 481 IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 482 482 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) … … 487 487 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 488 488 ! 489 DO_2D _00_00489 DO_2D( 0, 0, 0, 0 ) 490 490 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 491 491 ! … … 552 552 ! Consider later combining this into the loop above and looking for columns 553 553 ! where the index for base of the boundary layer have changed 554 DO_2D _00_00554 DO_2D( 0, 0, 0, 0 ) 555 555 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 556 556 zbeta = rab_n(ji,jj,1,jp_sal) … … 635 635 ! Average over the depth of the mixed layer in the convective boundary layer 636 636 ! Also calculate entrainment fluxes for temperature and salinity 637 DO_2D _00_00637 DO_2D( 0, 0, 0, 0 ) 638 638 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 639 639 zbeta = rab_n(ji,jj,1,jp_sal) … … 705 705 ! 706 706 707 DO_2D _00_00707 DO_2D( 0, 0, 0, 0 ) 708 708 ztemp = zu_ml(ji,jj) 709 709 zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) … … 723 723 zuw_bse = 0._wp 724 724 zvw_bse = 0._wp 725 DO_2D _00_00725 DO_2D( 0, 0, 0, 0 ) 726 726 727 727 IF ( lconv(ji,jj) ) THEN … … 740 740 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 741 741 742 DO_2D _00_00742 DO_2D( 0, 0, 0, 0 ) 743 743 ! 744 744 IF ( lconv (ji,jj) ) THEN … … 788 788 END_2D 789 789 ! 790 DO_2D _00_00790 DO_2D( 0, 0, 0, 0 ) 791 791 ! 792 792 IF ( lconv (ji,jj) ) THEN … … 832 832 ! zvisml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 833 833 ! ENDWHERE 834 DO_2D _00_00834 DO_2D( 0, 0, 0, 0 ) 835 835 IF ( lconv(ji,jj) ) THEN 836 836 zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird … … 846 846 END_2D 847 847 ! 848 DO_2D _00_00848 DO_2D( 0, 0, 0, 0 ) 849 849 IF ( lconv(ji,jj) ) THEN 850 850 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity … … 896 896 897 897 898 DO_2D _00_00898 DO_2D( 0, 0, 0, 0 ) 899 899 IF ( lconv(ji,jj) ) THEN 900 900 DO jk = 2, imld(ji,jj) … … 929 929 ENDWHERE 930 930 931 DO_2D _00_00931 DO_2D( 0, 0, 0, 0 ) 932 932 IF ( lconv(ji,jj) ) THEN 933 933 DO jk = 2, imld(ji,jj) … … 961 961 ENDWHERE 962 962 963 DO_2D _00_00963 DO_2D( 0, 0, 0, 0 ) 964 964 IF (lconv(ji,jj) ) THEN 965 965 DO jk = 2, imld(ji,jj) … … 993 993 ENDWHERE 994 994 995 DO_2D _00_00995 DO_2D( 0, 0, 0, 0 ) 996 996 IF ( lconv(ji,jj) ) THEN 997 997 DO jk = 2 , imld(ji,jj) … … 1021 1021 ENDWHERE 1022 1022 1023 DO_2D _00_001023 DO_2D( 0, 0, 0, 0 ) 1024 1024 IF ( lconv(ji,jj) ) THEN 1025 1025 DO jk = 2, imld(ji,jj) … … 1058 1058 ENDWHERE 1059 1059 1060 DO_2D _00_001060 DO_2D( 0, 0, 0, 0 ) 1061 1061 IF ( lconv(ji,jj) ) THEN 1062 1062 DO jk = 2, imld(ji,jj) … … 1093 1093 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 1094 1094 1095 DO_2D _00_001095 DO_2D( 0, 0, 0, 0 ) 1096 1096 IF ( lconv(ji,jj) ) THEN 1097 1097 DO jk = 2, ibld(ji,jj) … … 1122 1122 ! Temporary fix to avoid instabilities when zdb_bl becomes very very small 1123 1123 zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln ) 1124 DO_2D _00_001124 DO_2D( 0, 0, 0, 0 ) 1125 1125 DO jk= 2, ibld(ji,jj) 1126 1126 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) … … 1135 1135 ! Entrainment contribution. 1136 1136 1137 DO_2D _00_001137 DO_2D( 0, 0, 0, 0 ) 1138 1138 IF ( lconv(ji,jj) ) THEN 1139 1139 DO jk = 1, imld(ji,jj) - 1 … … 1170 1170 ! rotate non-gradient velocity terms back to model reference frame 1171 1171 1172 DO_2D _00_001172 DO_2D( 0, 0, 0, 0 ) 1173 1173 DO jk = 2, ibld(ji,jj) 1174 1174 ztemp = ghamu(ji,jj,jk) … … 1184 1184 ! KPP-style Ri# mixing 1185 1185 IF( ln_kpprimix) THEN 1186 DO_3D _10_10(2, jpkm1 )1186 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 1187 1187 z3du(ji,jj,jk) = 0.5 * ( uu(ji,jj,jk-1,Kmm) - uu(ji ,jj,jk,Kmm) ) & 1188 1188 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & … … 1193 1193 END_3D 1194 1194 ! 1195 DO_3D _00_00(2, jpkm1 )1195 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1196 1196 ! ! shear prod. at w-point weightened by mask 1197 1197 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & … … 1204 1204 END_3D 1205 1205 1206 DO_2D _00_001206 DO_2D( 0, 0, 0, 0 ) 1207 1207 DO jk = ibld(ji,jj) + 1, jpkm1 1208 1208 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri … … 1215 1215 ! KPP-style set diffusivity large if unstable below BL 1216 1216 IF( ln_convmix) THEN 1217 DO_2D _00_001217 DO_2D( 0, 0, 0, 0 ) 1218 1218 DO jk = ibld(ji,jj) + 1, jpkm1 1219 1219 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv … … 1227 1227 ! GN 25/8: need to change tmask --> wmask 1228 1228 1229 DO_3D _00_00(2, jpkm1 )1229 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1230 1230 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1231 1231 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) … … 1234 1234 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, & 1235 1235 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 1236 DO_3D _00_00(2, jpkm1 )1236 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1237 1237 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 1238 1238 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) … … 1395 1395 etmean(:,:,:) = 0.e0 1396 1396 1397 DO_3D _00_00(1, jpkm1 )1397 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1398 1398 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 1399 1399 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & … … 1409 1409 etmean(:,:,:) = 0.e0 1410 1410 1411 DO_3D _00_00(1, jpkm1 )1411 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1412 1412 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 1413 1413 & / MAX( 1., 2.* tmask(ji,jj,jk) & … … 1516 1516 ! 1517 1517 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 1518 DO_3D _11_11(1, jpkm1 )1518 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1519 1519 ikt = mbkt(ji,jj) 1520 1520 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) … … 1522 1522 END_3D 1523 1523 ! 1524 DO_2D _11_111524 DO_2D( 1, 1, 1, 1 ) 1525 1525 iiki = imld_rst(ji,jj) 1526 1526 hbl (ji,jj) = gdepw(ji,jj,iiki ,Kmm) * ssmask(ji,jj) ! Turbocline depth … … 1561 1561 1562 1562 ! add non-local temperature and salinity flux 1563 DO_3D _00_00(1, jpkm1 )1563 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1564 1564 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 1565 1565 & - ( ghamt(ji,jj,jk ) & … … 1629 1629 !code saving tracer trends removed, replace with trdmxl_oce 1630 1630 1631 DO_3D _00_00(1, jpkm1 )1631 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1632 1632 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) & 1633 1633 & - ( ghamu(ji,jj,jk ) & -
NEMO/trunk/src/OCE/ZDF/zdfric.F90
r13286 r13295 160 160 ! 161 161 ! !== avm and avt = F(Richardson number) ==! 162 DO_3D _10_10(2, jpkm1 )162 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 163 163 zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) ) 164 164 zav = rn_avmri * zcfRi**nn_ric … … 173 173 IF( ln_mldw ) THEN !== set a minimum value in the Ekman layer ==! 174 174 ! 175 DO_2D _00_00175 DO_2D( 0, 0, 0, 0 ) 176 176 zustar = SQRT( taum(ji,jj) * r1_rho0 ) 177 177 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 178 178 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range 179 179 END_2D 180 DO_3D _00_00(2, jpkm1 )180 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 181 181 IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 182 182 p_avm(ji,jj,jk) = MAX( p_avm(ji,jj,jk), rn_wvmix ) * wmask(ji,jj,jk) -
NEMO/trunk/src/OCE/ZDF/zdfsh2.F90
r13237 r13295 60 60 ! 61 61 DO jk = 2, jpkm1 62 DO_2D _10_1062 DO_2D( 1, 0, 1, 0 ) 63 63 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 64 64 & * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) & … … 72 72 & * wvmask(ji,jj,jk) 73 73 END_2D 74 DO_2D _00_0074 DO_2D( 0, 0, 0, 0 ) 75 75 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 76 76 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) -
NEMO/trunk/src/OCE/ZDF/zdfswm.F90
r12377 r13295 63 63 ! 64 64 zcoef = 1._wp * 0.353553_wp 65 DO_3D _00_00(2, jpkm1 )65 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 66 66 zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 67 67 ! -
NEMO/trunk/src/OCE/ZDF/zdftke.F90
r13286 r13295 224 224 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 225 225 ! 226 DO_2D _00_00226 DO_2D( 0, 0, 0, 0 ) 227 227 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 228 228 END_2D … … 238 238 IF( ln_drg ) THEN !== friction used as top/bottom boundary condition on TKE 239 239 ! 240 DO_2D _00_00240 DO_2D( 0, 0, 0, 0 ) 241 241 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 242 242 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) … … 247 247 END_2D 248 248 IF( ln_isfcav ) THEN ! top friction 249 DO_2D _00_00249 DO_2D( 0, 0, 0, 0 ) 250 250 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 251 251 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) … … 274 274 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 275 275 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 276 DO_3DS _11_11(jpkm1, 2, -1 )276 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 277 277 zus = zcof * taum(ji,jj) 278 278 IF( zpelc(ji,jj,jk) > zus ) imlc(ji,jj) = jk 279 279 END_3D 280 280 ! ! finite LC depth 281 DO_2D _11_11281 DO_2D( 1, 1, 1, 1 ) 282 282 zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 283 283 END_2D 284 284 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 285 DO_2D _00_00285 DO_2D( 0, 0, 0, 0 ) 286 286 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 287 287 zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 288 288 IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 289 289 END_2D 290 DO_3D _00_00(2, jpkm1 )290 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 291 291 IF ( zfr_i(ji,jj) /= 0. ) THEN 292 292 ! vertical velocity due to LC … … 310 310 ! 311 311 IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri ) 312 DO_3D _00_00(2, jpkm1 )312 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 313 313 ! ! local Richardson number 314 314 IF (rn2b(ji,jj,jk) <= 0.0_wp) then … … 322 322 ENDIF 323 323 ! 324 DO_3D _00_00(2, jpkm1 )324 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 325 325 zcof = zfact1 * tmask(ji,jj,jk) 326 326 ! ! A minimum of 2.e-5 m2/s is imposed on TKE vertical … … 344 344 END_3D 345 345 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 346 DO_3D _00_00(3, jpkm1 )346 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 347 347 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 348 348 END_3D 349 DO_2D _00_00349 DO_2D( 0, 0, 0, 0 ) 350 350 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 351 351 END_2D 352 DO_3D _00_00(3, jpkm1 )352 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 353 353 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 354 354 END_3D 355 DO_2D _00_00355 DO_2D( 0, 0, 0, 0 ) 356 356 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 357 357 END_2D 358 DO_3DS _00_00(jpk-2, 2, -1 )358 DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 359 359 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 360 360 END_3D 361 DO_3D _00_00(2, jpkm1 )361 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 362 362 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 363 363 END_3D … … 371 371 372 372 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 373 DO_3D _00_00(2, jpkm1 )373 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 374 374 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 375 375 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 376 376 END_3D 377 377 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) 378 DO_2D _00_00378 DO_2D( 0, 0, 0, 0 ) 379 379 jk = nmln(ji,jj) 380 380 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & … … 382 382 END_2D 383 383 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 384 DO_3D _00_00(2, jpkm1 )384 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 385 385 ztx2 = utau(ji-1,jj ) + utau(ji,jj) 386 386 zty2 = vtau(ji ,jj-1) + vtau(ji,jj) … … 456 456 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 457 457 #if ! defined key_si3 && ! defined key_cice 458 DO_2D _00_00458 DO_2D( 0, 0, 0, 0 ) 459 459 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 460 460 END_2D … … 463 463 ! 464 464 CASE( 0 ) ! No scaling under sea-ice 465 DO_2D _00_00465 DO_2D( 0, 0, 0, 0 ) 466 466 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 467 467 END_2D 468 468 ! 469 469 CASE( 1 ) ! scaling with constant sea-ice thickness 470 DO_2D _00_00470 DO_2D( 0, 0, 0, 0 ) 471 471 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 472 472 END_2D 473 473 ! 474 474 CASE( 2 ) ! scaling with mean sea-ice thickness 475 DO_2D _00_00475 DO_2D( 0, 0, 0, 0 ) 476 476 #if defined key_si3 477 477 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) … … 483 483 ! 484 484 CASE( 3 ) ! scaling with max sea-ice thickness 485 DO_2D _00_00485 DO_2D( 0, 0, 0, 0 ) 486 486 zmaxice = MAXVAL( h_i(ji,jj,:) ) 487 487 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) … … 491 491 #endif 492 492 ! 493 DO_2D _00_00493 DO_2D( 0, 0, 0, 0 ) 494 494 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 495 495 END_2D … … 500 500 501 501 ! 502 DO_3D _00_00(2, jpkm1 )502 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 503 503 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 504 504 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) … … 515 515 ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 516 516 CASE ( 0 ) ! bounded by the distance to surface and bottom 517 DO_3D _00_00(2, jpkm1 )517 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 518 518 zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk), & 519 519 & gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) … … 526 526 ! 527 527 CASE ( 1 ) ! bounded by the vertical scale factor 528 DO_3D _00_00(2, jpkm1 )528 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 529 529 zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 530 530 zmxlm(ji,jj,jk) = zemxl … … 533 533 ! 534 534 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 535 DO_3D _00_00(2, jpkm1 )535 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 536 536 zmxlm(ji,jj,jk) = & 537 537 & MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 538 538 END_3D 539 DO_3DS _00_00(jpkm1, 2, -1 )539 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) 540 540 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 541 541 zmxlm(ji,jj,jk) = zemxl … … 544 544 ! 545 545 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 546 DO_3D _00_00(2, jpkm1 )546 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 547 547 zmxld(ji,jj,jk) = & 548 548 & MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 549 549 END_3D 550 DO_3DS _00_00(jpkm1, 2, -1 )550 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) 551 551 zmxlm(ji,jj,jk) = & 552 552 & MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 553 553 END_3D 554 DO_3D _00_00(2, jpkm1 )554 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 555 555 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 556 556 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) … … 564 564 ! ! Vertical eddy viscosity and diffusivity (avm and avt) 565 565 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 566 DO_3D _00_00(1, jpkm1 )566 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 567 567 zsqen = SQRT( en(ji,jj,jk) ) 568 568 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen … … 574 574 ! 575 575 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 576 DO_3D _00_00(2, jpkm1 )576 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 577 577 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 578 578 END_3D -
NEMO/trunk/src/OCE/do_loop_substitute.h90
r13286 r13295 47 47 ! END_2D 48 48 ! 49 ! similar conventions apply to the 3D loops macros. jk loop limits are retained through macro arguments and are not restricted. This 50 ! includes the possibility of strides for which an extra set of DO_3DS macros are defined. 49 ! similar conventions apply to the 3D loops macros. jk loop limits are retained through macro arguments 50 ! and are not restricted. This includes the possibility of strides for which an extra set of DO_3DS 51 ! macros are defined. 51 52 ! 52 ! In the following definitions the inner PE domain is defined by start indices of (_Nis0, Njs0) and end indices of (Nie0, Njs0) 53 ! The following macros are defined just below: _Nis0, Njs0, _Nis1, Njs1, _Nie0, Njs0, _Nie1, Nje1. 54 ! These names are chosen to, hopefully, avoid any future, unintended matches elsewhere in the code. 53 ! In the following definitions the inner PE domain is defined by start indices of (Nis0, Njs0) and end 54 ! indices of (Nie0, Nje0) where: 55 55 ! 56 !!gm changes ; 57 ! 58 ! -0- fortran code : defined in par_oce.F90 the folowwing valiables : 59 !!# 60 !!# INTEGER, PUBLIC :: Nis0, Nis1, Nis2 !: start I-index (_0: no halo, _1 & _2: 1 & 2-halos) 61 !!# INTEGER, PUBLIC :: Nie0, Nie1, Nie2 !: end I-index (_0: no halo, _1 & _2: 1 & 2-halos) 62 !!# INTEGER, PUBLIC :: Njs0, Njs1, Njs2 !: start J-index (_0: no halo, _1 & _2: 1 & 2-halos) 63 !!# INTEGER, PUBLIC :: Nje0, Nje1, Nje2 !: end J-index (_0: no halo, _1 & _2: 1 & 2-halos) 64 !!# 65 ! -1- fortran code put in mppinit.F90 : 66 !!# just after the futur read of nn_hls in namXXX (to be defined) 67 !!# NB: currently nn_hls is defined as a parameter in par_oce.F90 68 !!# SUBROUTINE init_do_loop 69 !!# !!---------------------------------------------------------------------- 70 !!# !! *** ROUTINE init_do_loop_indices *** 71 !!# !! 72 !!# !! ** Purpose : set the starting/ending indices of DO-loop 73 !!# !! These indices are used in do_loop_substitute.h90 74 !!# !!----------------------------------------------------------------------!!# ! !== set the starting/ending indices of DO-loop ==! (used in do_loop_substitute.h90) 75 !!# ! 76 !!# IF( nn_hls == 1 ) THEN !* halo size of 1 77 !!# ! 78 !!# Nis0 = 2 ; Nis1 = 1 ; Nis2 = Nis1 79 !!# Njs0 = Nis0 ; Njs1 = Nis1 ; Njs2 = Nis1 80 !!# ! 81 !!# Nie0 = jpi-1 ; Nje1 = jpi ; Nie2 = Nie1 82 !!# Nje0 = jpj-1 ; Nje1 = jpj-1 ; Nje2 = Nie1 83 !!# ! 84 !!# ELSEIF( nn_hls == 2 ) THEN !* halo size of 2 85 !!# ! 86 !!# Nis0 = 3 ; Nis1 = 2 ; Nis2 = 1 87 !!# Njs0 = Nis0 ; Njs1 = Nis1 ; Njs2 = Nis2 88 !!# ! 89 !!# Nie0 = jpi-2 ; Nje1 = jpi-1 ; Nie2 = jpi 90 !!# Nje0 = jpj-2 ; Nje1 = jpj-1 ; Nje2 = jpj 91 !!# ! 92 !!# ELSE !* unexpected halo size 93 !!# CALL ctl_stop( 'STOP', 'ini_mpp: wrong value of halo size : nn_hls= 1 or 2 only !') 94 !!# ENDIF 95 !!# 96 !!# ! 97 !!# END SUBROUTINE init_do_loop 98 ! 99 ! ! -2- in do_loop_substitute becomes : 56 ! Nis0 = 1 + nn_hls Njs0 = 1 + nn_hls 57 ! Nie0 = jpi - nn_hls Nje0 = jpj - nn_hls 100 58 ! 101 59 #endif 102 60 103 ! 2D loops with 1 61 #define DO_2D(B, T, L, R) DO jj = Njs0-(B), Nje0+(T) ; DO ji = Nis0-(L), Nie0+(R) 104 62 105 #define DO_2D_00_00 DO jj = Njs0, Nje0 ; DO ji = Nis0, Nie0 106 #define DO_2D_00_01 DO jj = Njs0, Nje0 ; DO ji = Nis0, Nie1 107 #define DO_2D_00_10 DO jj = Njs0, Nje0 ; DO ji = Nis1, Nie0 108 #define DO_2D_00_11 DO jj = Njs0, Nje0 ; DO ji = Nis1, Nie1 109 110 #define DO_2D_01_00 DO jj = Njs0, Nje1 ; DO ji = Nis0, Nie0 111 #define DO_2D_01_01 DO jj = Njs0, Nje1 ; DO ji = Nis0, Nie1 112 #define DO_2D_01_10 DO jj = Njs0, Nje1 ; DO ji = Nis1, Nie0 113 #define DO_2D_01_11 DO jj = Njs0, Nje1 ; DO ji = Nis1, Nie1 114 115 #define DO_2D_10_00 DO jj = Njs1, Nje0 ; DO ji = Nis0, Nie0 116 #define DO_2D_10_01 DO jj = Njs1, Nje0 ; DO ji = Nis0, Nie1 ! not used ? 117 #define DO_2D_10_10 DO jj = Njs1, Nje0 ; DO ji = Nis1, Nie0 118 #define DO_2D_10_11 DO jj = Njs1, Nje0 ; DO ji = Nis1, Nie1 119 120 #define DO_2D_11_00 DO jj = Njs1, Nje1 ; DO ji = Nis0, Nie0 121 #define DO_2D_11_01 DO jj = Njs1, Nje1 ; DO ji = Nis0, Nie1 122 #define DO_2D_11_10 DO jj = Njs1, Nje1 ; DO ji = Nis1, Nie0 123 #define DO_2D_11_11 DO jj = Njs1, Nje1 ; DO ji = Nis1, Nie1 63 #define DO_3D(B, T, L, R, ks, ke) DO jk = ks, ke ; DO_2D(B, T, L, R) 124 64 125 ! 2D loops with 1 following a 2/3D loop with 2 65 #define DO_3DS(B, T, L, R, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D(B, T, L, R) 126 66 127 #define DO_2D_00_01nxt2 DO jj = Njs0 , Nje0 ; DO ji = Nis0 , Nie1nxt2128 #define DO_2D_00_10nxt2 DO jj = Njs0 , Nje0 ; DO ji = Nis1nxt2, Nie0129 #define DO_2D_00_11nxt2 DO jj = Njs0 , Nje0 ; DO ji = Nis1nxt2, Nie1nxt2130 131 #define DO_2D_01_00nxt2 DO jj = Njs0 , Nje1nxt2 ; DO ji = Nis0 , Nie0132 #define DO_2D_01_01nxt2 DO jj = Njs0 , Nje1nxt2 ; DO ji = Nis0 , Nie1nxt2133 #define DO_2D_01_10nxt2 DO jj = Njs0 , Nje1nxt2 ; DO ji = Nis1nxt2, Nie0134 #define DO_2D_01_11nxt2 DO jj = Njs0 , Nje1nxt2 ; DO ji = Nis1nxt2, Nie1nxt2135 136 #define DO_2D_10_00nxt2 DO jj = Njs1nxt2, Nje0 ; DO ji = Nis0 , Nie0137 #define DO_2D_10_01nxt2 DO jj = Njs1nxt2, Nje0 ; DO ji = Nis0 , Nie1nxt2 ! not used ?138 #define DO_2D_10_10nxt2 DO jj = Njs1nxt2, Nje0 ; DO ji = Nis1nxt2, Nie0139 #define DO_2D_10_11nxt2 DO jj = Njs1nxt2, Nje0 ; DO ji = Nis1nxt2, Nie1nxt2140 141 #define DO_2D_11_00nxt2 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis0 , Nie0142 #define DO_2D_11_01nxt2 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis0 , Nie1nxt2143 #define DO_2D_11_10nxt2 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis1nxt2, Nie0144 #define DO_2D_11_11nxt2 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis1nxt2, Nie1nxt2145 146 ! 2D loops with 2147 148 #define DO_2D_11_12 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis1nxt2, Nie2149 #define DO_2D_11_21 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis2 , Nie1nxt2150 #define DO_2D_11_22 DO jj = Njs1nxt2, Nje1nxt2 ; DO ji = Nis2 , Nie2151 152 #define DO_2D_12_11 DO jj = Njs1nxt2, Nje2 ; DO ji = Nis1nxt2, Nie1nxt2153 #define DO_2D_12_12 DO jj = Njs1nxt2, Nje2 ; DO ji = Nis1nxt2, Nie2154 #define DO_2D_12_21 DO jj = Njs1nxt2, Nje2 ; DO ji = Nis2 , Nie1nxt2155 #define DO_2D_12_22 DO jj = Njs1nxt2, Nje2 ; DO ji = Nis2 , Nie2156 157 #define DO_2D_21_11 DO jj = Njs2 , Nje1nxt2 ; DO ji = Nis1nxt2, Nie1nxt2158 #define DO_2D_21_12 DO jj = Njs2 , Nje1nxt2 ; DO ji = Nis1nxt2, Nie2 ! not used ?159 #define DO_2D_21_21 DO jj = Njs2 , Nje1nxt2 ; DO ji = Nis2 , Nie1nxt2160 #define DO_2D_21_22 DO jj = Njs2 , Nje1nxt2 ; DO ji = Nis2 , Nie2161 162 #define DO_2D_22_11 DO jj = Njs2 , Nje2 ; DO ji = Nis1nxt2, Nie1nxt2163 #define DO_2D_22_12 DO jj = Njs2 , Nje2 ; DO ji = Nis1nxt2, Nie2164 #define DO_2D_22_21 DO jj = Njs2 , Nje2 ; DO ji = Nis2 , Nie1nxt2165 #define DO_2D_22_22 DO jj = Njs2 , Nje2 ; DO ji = Nis2 , Nie2166 167 ! 3D loops with 1168 169 #define DO_3D_00_00(ks,ke) DO jk = ks, ke ; DO_2D_00_00170 #define DO_3D_00_01(ks,ke) DO jk = ks, ke ; DO_2D_00_01171 #define DO_3D_00_10(ks,ke) DO jk = ks, ke ; DO_2D_00_10172 #define DO_3D_00_11(ks,ke) DO jk = ks, ke ; DO_2D_00_11173 174 #define DO_3D_01_00(ks,ke) DO jk = ks, ke ; DO_2D_01_00175 #define DO_3D_01_01(ks,ke) DO jk = ks, ke ; DO_2D_01_01176 #define DO_3D_01_10(ks,ke) DO jk = ks, ke ; DO_2D_01_10177 #define DO_3D_01_11(ks,ke) DO jk = ks, ke ; DO_2D_01_11178 179 #define DO_3D_10_00(ks,ke) DO jk = ks, ke ; DO_2D_10_00180 #define DO_3D_10_01(ks,ke) DO jk = ks, ke ; DO_2D_10_01181 #define DO_3D_10_10(ks,ke) DO jk = ks, ke ; DO_2D_10_10182 #define DO_3D_10_11(ks,ke) DO jk = ks, ke ; DO_2D_10_11183 184 #define DO_3D_11_00(ks,ke) DO jk = ks, ke ; DO_2D_11_00185 #define DO_3D_11_01(ks,ke) DO jk = ks, ke ; DO_2D_11_01186 #define DO_3D_11_10(ks,ke) DO jk = ks, ke ; DO_2D_11_10187 #define DO_3D_11_11(ks,ke) DO jk = ks, ke ; DO_2D_11_11188 189 ! 3D loops with 1, following a 2/3D loop with 2190 191 #define DO_3D_00_01nxt2(ks,ke) DO jk = ks, ke ; DO_2D_00_01nxt2192 #define DO_3D_00_10nxt2(ks,ke) DO jk = ks, ke ; DO_2D_00_10nxt2193 #define DO_3D_00_11nxt2(ks,ke) DO jk = ks, ke ; DO_2D_00_11nxt2194 195 #define DO_3D_01_00nxt2(ks,ke) DO jk = ks, ke ; DO_2D_01_00nxt2196 #define DO_3D_01_01nxt2(ks,ke) DO jk = ks, ke ; DO_2D_01_01nxt2197 #define DO_3D_01_10nxt2(ks,ke) DO jk = ks, ke ; DO_2D_01_10nxt2198 #define DO_3D_01_11nxt2(ks,ke) DO jk = ks, ke ; DO_2D_01_11nxt2199 200 #define DO_3D_10_00nxt2(ks,ke) DO jk = ks, ke ; DO_2D_10_00nxt2201 #define DO_3D_10_01nxt2(ks,ke) DO jk = ks, ke ; DO_2D_10_01nxt2202 #define DO_3D_10_10nxt2(ks,ke) DO jk = ks, ke ; DO_2D_10_10nxt2203 #define DO_3D_10_11nxt2(ks,ke) DO jk = ks, ke ; DO_2D_10_11nxt2204 205 #define DO_3D_11_00nxt2(ks,ke) DO jk = ks, ke ; DO_2D_11_00nxt2206 #define DO_3D_11_01nxt2(ks,ke) DO jk = ks, ke ; DO_2D_11_01nxt2207 #define DO_3D_11_10nxt2(ks,ke) DO jk = ks, ke ; DO_2D_11_10nxt2208 #define DO_3D_11_11nxt2(ks,ke) DO jk = ks, ke ; DO_2D_11_11nxt2209 210 ! 3D loops with 2211 212 #define DO_3D_11_12(ks,ke) DO jk = ks, ke ; DO_2D_11_12213 #define DO_3D_11_21(ks,ke) DO jk = ks, ke ; DO_2D_11_21214 #define DO_3D_11_22(ks,ke) DO jk = ks, ke ; DO_2D_11_22215 216 #define DO_3D_12_11(ks,ke) DO jk = ks, ke ; DO_2D_12_11217 #define DO_3D_12_12(ks,ke) DO jk = ks, ke ; DO_2D_12_12218 #define DO_3D_12_21(ks,ke) DO jk = ks, ke ; DO_2D_12_21219 #define DO_3D_12_22(ks,ke) DO jk = ks, ke ; DO_2D_12_22220 221 #define DO_3D_21_11(ks,ke) DO jk = ks, ke ; DO_2D_21_11222 #define DO_3D_21_12(ks,ke) DO jk = ks, ke ; DO_2D_21_12223 #define DO_3D_21_21(ks,ke) DO jk = ks, ke ; DO_2D_21_21224 #define DO_3D_21_22(ks,ke) DO jk = ks, ke ; DO_2D_21_22225 226 #define DO_3D_22_11(ks,ke) DO jk = ks, ke ; DO_2D_22_11227 #define DO_3D_22_12(ks,ke) DO jk = ks, ke ; DO_2D_22_12228 #define DO_3D_22_21(ks,ke) DO jk = ks, ke ; DO_2D_22_21229 #define DO_3D_22_22(ks,ke) DO jk = ks, ke ; DO_2D_22_22230 231 ! 3D loops with increment with 1232 233 #define DO_3DS_00_00(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_00234 #define DO_3DS_00_01(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_01235 #define DO_3DS_00_10(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_10236 #define DO_3DS_00_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_11237 238 #define DO_3DS_01_00(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_00239 #define DO_3DS_01_01(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_01240 #define DO_3DS_01_10(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_10241 #define DO_3DS_01_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_11242 243 #define DO_3DS_10_00(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_00244 #define DO_3DS_10_01(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_01245 #define DO_3DS_10_10(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_10246 #define DO_3DS_10_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_11247 248 #define DO_3DS_11_00(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_00249 #define DO_3DS_11_01(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_01250 #define DO_3DS_11_10(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_10251 #define DO_3DS_11_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_11252 253 ! 3D loops with increment with 1, following a 2/3D loop with 2254 255 #define DO_3DS_00_01nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_01nxt2256 #define DO_3DS_00_10nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_10nxt2257 #define DO_3DS_00_11nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_00_11nxt2258 259 #define DO_3DS_01_00nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_00nxt2260 #define DO_3DS_01_01nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_01nxt2261 #define DO_3DS_01_10nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_10nxt2262 #define DO_3DS_01_11nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_01_11nxt2263 264 #define DO_3DS_10_00nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_00nxt2265 #define DO_3DS_10_01nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_01nxt2266 #define DO_3DS_10_10nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_10nxt2267 #define DO_3DS_10_11nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_10_11nxt2268 269 #define DO_3DS_11_00nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_00nxt2270 #define DO_3DS_11_01nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_01nxt2271 #define DO_3DS_11_10nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_10nxt2272 #define DO_3DS_11_11nxt2(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_11nxt2273 274 ! 3D loops with increment with 2275 276 #define DO_3DS_11_12(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_12277 #define DO_3DS_11_21(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_21278 #define DO_3DS_11_22(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_11_22279 280 #define DO_3DS_12_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_12_11281 #define DO_3DS_12_12(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_12_12282 #define DO_3DS_12_21(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_12_21283 #define DO_3DS_12_22(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_12_22284 285 #define DO_3DS_21_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_21_11286 #define DO_3DS_21_12(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_21_12287 #define DO_3DS_21_21(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_21_21288 #define DO_3DS_21_22(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_21_22289 290 #define DO_3DS_22_11(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_22_11291 #define DO_3DS_22_12(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_22_12292 #define DO_3DS_22_21(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_22_21293 #define DO_3DS_22_22(ks,ke,ki) DO jk = ks, ke, ki ; DO_2D_22_22294 295 67 #define END_2D END DO ; END DO 296 68 #define END_3D END DO ; END DO ; END DO -
NEMO/trunk/src/OCE/lib_fortran.F90
r13226 r13295 217 217 IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 218 218 ! 219 DO_2D _11_11219 DO_2D( 1, 1, 1, 1 ) 220 220 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 221 221 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box … … 264 264 ! 265 265 DO jn = 1, ipn 266 DO_2D _11_11266 DO_2D( 1, 1, 1, 1 ) 267 267 IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN ! bottom left corber of a 3x3 box 268 268 ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box
Note: See TracChangeset
for help on using the changeset viewer.