- Timestamp:
- 2021-07-15T11:11:28+02:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src
- Files:
-
- 57 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/DIA/diawri.F90
r15080 r15122 160 160 ENDIF 161 161 162 ! initialize arrays 163 z2d(:,:) = 0._wp 164 z3d(:,:,:) = 0._wp 165 162 166 ! Output of initial vertical scale factor 163 167 CALL iom_put("e3t_0", e3t_0(:,:,:) ) … … 167 171 ! 168 172 IF ( iom_use("tpt_dep") ) THEN 169 DO jk = 1, jpk170 z3d( :,:,jk) = gdept(:,:,jk,Kmm)171 END DO173 DO_3D( 0, 0, 0, 0, 1, jpk ) 174 z3d(ji,jj,jk) = gdept(ji,jj,jk,Kmm) 175 END_3D 172 176 CALL iom_put( "tpt_dep", z3d ) 173 177 ENDIF 174 178 179 ! --- vertical scale factors --- ! 175 180 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t 176 DO jk = 1, jpk177 z3d( :,:,jk) = e3t(:,:,jk,Kmm)178 END DO181 DO_3D( 0, 0, 0, 0, 1, jpk ) 182 z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm) 183 END_3D 179 184 CALL iom_put( "e3t", z3d ) 180 185 IF ( iom_use("e3tdef") ) THEN 181 z3d(:,:,:) = ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100._wp * tmask(:,:,:) ) ** 2 186 DO_3D( 0, 0, 0, 0, 1, jpk ) 187 z3d(ji,jj,jk) = ( ( z3d(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100._wp * tmask(ji,jj,jk) ) ** 2 188 END_3D 182 189 CALL iom_put( "e3tdef", z3d ) 183 190 ENDIF 184 191 ENDIF 185 192 IF ( iom_use("e3u") ) THEN ! time-varying e3u 186 DO jk = 1, jpk187 z3d( :,:,jk) = e3u(:,:,jk,Kmm)188 END DO193 DO_3D( 0, 0, 0, 0, 1, jpk ) 194 z3d(ji,jj,jk) = e3u(ji,jj,jk,Kmm) 195 END_3D 189 196 CALL iom_put( "e3u" , z3d ) 190 197 ENDIF 191 198 IF ( iom_use("e3v") ) THEN ! time-varying e3v 192 DO jk = 1, jpk193 z3d( :,:,jk) = e3v(:,:,jk,Kmm)194 END DO199 DO_3D( 0, 0, 0, 0, 1, jpk ) 200 z3d(ji,jj,jk) = e3v(ji,jj,jk,Kmm) 201 END_3D 195 202 CALL iom_put( "e3v" , z3d ) 196 203 ENDIF 197 204 IF ( iom_use("e3w") ) THEN ! time-varying e3w 198 DO jk = 1, jpk199 z3d( :,:,jk) = e3w(:,:,jk,Kmm)200 END DO205 DO_3D( 0, 0, 0, 0, 1, jpk ) 206 z3d(ji,jj,jk) = e3w(ji,jj,jk,Kmm) 207 END_3D 201 208 CALL iom_put( "e3w" , z3d ) 202 209 ENDIF 203 210 IF ( iom_use("e3f") ) THEN ! time-varying e3f caution here at Kaa 204 DO jk = 1, jpk205 z3d( :,:,jk) = e3f(:,:,jk)206 END DO211 DO_3D( 0, 0, 0, 0, 1, jpk ) 212 z3d(ji,jj,jk) = e3f(ji,jj,jk) 213 END_3D 207 214 CALL iom_put( "e3f" , z3d ) 208 215 ENDIF … … 224 231 IF( iom_use("hf") ) CALL iom_put( "hf" , hf_0(:,:)*( 1._wp + r3f(:,:) ) ) ! water column at f-point (caution here at Naa) 225 232 #endif 226 233 234 ! --- tracers T&S --- ! 227 235 CALL iom_put( "toce_"//ttype, ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature 228 236 CALL iom_put( "sst_"//ttype, ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 237 229 238 IF ( iom_use("sbt_"//ttype) ) THEN 230 239 DO_2D( 0, 0, 0, 0 ) … … 247 256 IF( .NOT.lk_SWE ) CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0) 248 257 258 ! --- momentum --- ! 249 259 IF ( iom_use("taubot") ) THEN ! bottom stress 250 260 zztmp = rho0 * 0.25_wp … … 282 292 283 293 ! ! vertical velocity 284 IF( ln_zad_Aimp ) THEN ; IF( iom_use('woce') ) CALL iom_put( "woce", ww + wi ) ! explicit plus implicit parts 285 ELSE ; CALL iom_put( "woce", ww ) 294 IF( ln_zad_Aimp ) THEN 295 IF( iom_use('woce') ) THEN 296 DO_3D( 0, 0, 0, 0, 1, jpk ) 297 z3d(ji,jj,jk) = ww(ji,jj,jk) + wi(ji,jj,jk) 298 END_3D 299 CALL iom_put( "woce", z3d ) ! explicit plus implicit parts 300 ENDIF 301 ELSE 302 CALL iom_put( "woce", ww ) 286 303 ENDIF 287 304 288 305 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 289 306 ! ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 290 DO jk = 1, jpk 291 IF( ln_zad_Aimp ) THEN 292 z3d(:,:,jk) = rho0 * e1e2t(:,:) * ( ww(:,:,jk) + wi(:,:,jk) ) 293 ELSE 294 z3d(:,:,jk) = rho0 * e1e2t(:,:) * ww(:,:,jk) 295 ENDIF 296 END DO 307 IF( ln_zad_Aimp ) THEN 308 DO_3D( 0, 0, 0, 0, 1, jpk ) 309 z3d(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wi(ji,jj,jk) ) 310 END_3D 311 ELSE 312 DO_3D( 0, 0, 0, 0, 1, jpk ) 313 z3d(ji,jj,jk) = rho0 * e1e2t(ji,jj) * ww(ji,jj,jk) 314 END_3D 315 ENDIF 297 316 CALL iom_put( "w_masstr" , z3d ) 298 317 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d * z3d ) … … 366 385 ! 367 386 IF ( iom_use("ke") .OR. iom_use("ke_int") ) THEN 368 z3d(:,:,jpk) = 0._wp 369 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 387 DO_3D( 0, 0, 0, 0, 1, jpk ) 370 388 zztmpx = uu(ji-1,jj ,jk,Kmm) + uu(ji,jj,jk,Kmm) 371 389 zztmpy = vv(ji ,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm) … … 409 427 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 410 428 411 z3d(:,:,jpk) = 0._wp 412 DO jk = 1, jpkm1 413 z3d(:,:,jk) = rho0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk) 414 END DO 429 DO_3D( 0, 0, 0, 0, 1, jpk ) 430 z3d(ji,jj,jk) = rho0 * uu(ji,jj,jk,Kmm) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 431 END_3D 415 432 CALL iom_put( "u_masstr" , z3d ) ! mass transport in i-direction 416 433 … … 418 435 z2d(:,:) = 0._wp 419 436 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 420 z2d( :,:) = z2d(:,:) + z3d(:,:,jk)437 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 421 438 END_3D 422 439 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum … … 442 459 IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 443 460 444 z3d(:,:,jpk) = 0._wp 445 DO jk = 1, jpkm1 446 z3d(:,:,jk) = rho0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk) 447 END DO 461 DO_3D( 0, 0, 0, 0, 1, jpk ) 462 z3d(ji,jj,jk) = rho0 * vv(ji,jj,jk,Kmm) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 463 END_3D 448 464 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 449 465 -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/DYN/dynldf_iso.F90
r14834 r15122 131 131 ! ! allocate dyn_ldf_iso arrays 132 132 IF( dyn_ldf_iso_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 133 ! 134 DO_2D_OVR( 0, 0, 0, 0 ) 135 akzu(ji,jj,1) = 0._wp 136 akzu(ji,jj,jpk) = 0._wp 137 akzv(ji,jj,1) = 0._wp 138 akzv(ji,jj,jpk) = 0._wp 139 END_2D 140 ! 133 141 ENDIF 134 142 ENDIF -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbclv.F90
r14030 r15122 133 133 newpt%lon = glamt(ji,jj) ! at t-point (centre of the cell) 134 134 newpt%lat = gphit(ji,jj) 135 newpt%xi = REAL( mig(ji), wp ) 136 newpt%yj = REAL( mjg(jj), wp ) 135 newpt%xi = REAL( mig(ji), wp ) - ( nn_hls - 1 ) 136 newpt%yj = REAL( mjg(jj), wp ) - ( nn_hls - 1 ) 137 137 ! 138 138 newpt%uvel = 0._wp ! initially at rest -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbdyn.F90
r14400 r15122 192 192 ld_bounced = .FALSE. 193 193 ! 194 ii0 = INT( pi0+0.5 ) ; ij0 = INT( pj0+0.5 )! initial gridpoint position (T-cell)195 ii = INT( pi +0.5 ) ; ij = INT( pj +0.5 )! current - -194 ii0 = INT( pi0+0.5 ) + (nn_hls-1) ; ij0 = INT( pj0+0.5 ) + (nn_hls-1) ! initial gridpoint position (T-cell) 195 ii = INT( pi +0.5 ) + (nn_hls-1) ; ij = INT( pj +0.5 ) + (nn_hls-1) ! current - - 196 196 ! 197 197 IF( ii == ii0 .AND. ij == ij0 ) RETURN ! berg remains in the same cell … … 314 314 zwmod = zuwave*zuwave + zvwave*zvwave ! The wave amplitude and length depend on the current; 315 315 ! ! wind speed relative to the ocean. Actually wmod is wmod**2 here. 316 zampl = 0.5 * 0.02025 * zwmod! This is "a", the wave amplitude317 zLwavelength = 0.32 * zwmod! Surface wave length fitted to data in table at316 zampl = 0.5_wp * 0.02025_wp * zwmod ! This is "a", the wave amplitude 317 zLwavelength = 0.32_wp * zwmod ! Surface wave length fitted to data in table at 318 318 ! ! http://www4.ncsu.edu/eos/users/c/ceknowle/public/chapter10/part2.html 319 zLcutoff = 0.125 * zLwavelength320 zLtop = 0.25 * zLwavelength321 zCr = pp_Cr0 * MIN( MAX( 0. , (zL-zLcutoff) / ((zLtop-zLcutoff)+1.e-30)) , 1.) ! Wave radiation coefficient319 zLcutoff = 0.125_wp * zLwavelength 320 zLtop = 0.25_wp * zLwavelength 321 zCr = pp_Cr0 * MIN( MAX( 0._wp, (zL-zLcutoff) / ((zLtop-zLcutoff)+1.e-30)) , 1._wp) ! Wave radiation coefficient 322 322 ! ! fitted to graph from Carrieres et al., POAC Drift Model. 323 zwave_rad = 0.5 * pp_rho_seawater / zM * zCr * grav * zampl * MIN( zampl,zF ) * (2.*zW*zL) / (zW+zL)323 zwave_rad = 0.5_wp * pp_rho_seawater / zM * zCr * grav * zampl * MIN( zampl,zF ) * (2._wp*zW*zL) / (zW+zL) 324 324 zwmod = SQRT( zua*zua + zva*zva ) ! Wind speed 325 325 IF( zwmod /= 0._wp ) THEN … … 327 327 zvwave = zva/zwmod 328 328 ELSE 329 zuwave = 0. ; zvwave=0. ; zwave_rad=0.! ... and only when wind is present. !!gm wave_rad=0. is useless329 zuwave = 0._wp ; zvwave=0._wp ; zwave_rad=0._wp ! ... and only when wind is present. !!gm wave_rad=0. is useless 330 330 ENDIF 331 331 332 332 ! Weighted drag coefficients 333 z_ocn = pp_rho_seawater / zM * (0.5 *pp_Cd_wv*zW*(zD_hi)+pp_Cd_wh*zW*zL)334 z_atm = pp_rho_air / zM * (0.5 *pp_Cd_av*zW*zF +pp_Cd_ah*zW*zL)335 z_ice = pp_rho_ice / zM * (0.5 *pp_Cd_iv*zW*zhi )333 z_ocn = pp_rho_seawater / zM * (0.5_wp*pp_Cd_wv*zW*(zD_hi)+pp_Cd_wh*zW*zL) 334 z_atm = pp_rho_air / zM * (0.5_wp*pp_Cd_av*zW*zF +pp_Cd_ah*zW*zL) 335 z_ice = pp_rho_ice / zM * (0.5_wp*pp_Cd_iv*zW*zhi ) 336 336 IF( abs(zui) + abs(zvi) == 0._wp ) z_ice = 0._wp 337 337 … … 358 358 DO itloop = 1, 2 ! Iterate on drag coefficients 359 359 ! 360 zus = 0.5 * ( zuveln + puvel )361 zvs = 0.5 * ( zvveln + pvvel )360 zus = 0.5_wp * ( zuveln + puvel ) 361 zvs = 0.5_wp * ( zvveln + pvvel ) 362 362 zdrag_ocn = z_ocn * SQRT( (zus-zuo)*(zus-zuo) + (zvs-zvo)*(zvs-zvo) ) 363 363 zdrag_atm = z_atm * SQRT( (zus-zua)*(zus-zua) + (zvs-zva)*(zvs-zva) ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbini.F90
r14433 r15122 182 182 i3 = INT( src_calving(i1,jpj/2) ) 183 183 jj = INT( i3/nicbpack ) 184 ricb_left = REAL( i3 - nicbpack*jj, wp ) 184 ricb_left = REAL( i3 - nicbpack*jj, wp ) - (nn_hls-1) 185 185 i1 = MIN( nicbei+1, jpi ) 186 186 i3 = INT( src_calving(i1,jpj/2) ) 187 187 jj = INT( i3/nicbpack ) 188 ricb_right = REAL( i3 - nicbpack*jj, wp ) 188 ricb_right = REAL( i3 - nicbpack*jj, wp ) - (nn_hls-1) 189 189 190 190 ! north fold … … 360 360 rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN 361 361 localberg%mass_scaling = rn_mass_scaling(iberg) 362 localpt%xi = REAL( mig(ji) , wp )363 localpt%yj = REAL( mjg(jj) , wp )362 localpt%xi = REAL( mig(ji) - (nn_hls-1), wp ) 363 localpt%yj = REAL( mjg(jj) - (nn_hls-1), wp ) 364 364 CALL icb_utl_interp( localpt%xi, localpt%yj, plat=localpt%lat, plon=localpt%lon ) 365 365 localpt%mass = rn_initial_mass (iberg) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icblbc.F90
r14433 r15122 229 229 DO WHILE (ASSOCIATED(this)) 230 230 pt => this%current_point 231 IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN231 IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) ) THEN 232 232 tmpberg => this 233 233 this => this%next … … 242 242 CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 243 243 CALL icb_utl_delete(first_berg, tmpberg) 244 ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN244 ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) ) THEN 245 245 tmpberg => this 246 246 this => this%next … … 321 321 DO WHILE (ASSOCIATED(this)) 322 322 pt => this%current_point 323 IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN323 IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 324 324 tmpberg => this 325 325 this => this%next … … 331 331 CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 332 332 CALL icb_utl_delete(first_berg, tmpberg) 333 ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN333 ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) ) THEN 334 334 tmpberg => this 335 335 this => this%next … … 442 442 DO WHILE (ASSOCIATED(this)) 443 443 pt => this%current_point 444 IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp .OR. &445 pt%xi > REAL(mig(nicbei),wp) + 0.5_wp .OR. &446 pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp .OR. &447 pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN444 IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) .OR. & 445 pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) .OR. & 446 pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) .OR. & 447 pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 448 448 i = i + 1 449 449 WRITE(numicb,*) 'berg lost in halo: ', this%number(:) … … 514 514 DO WHILE (ASSOCIATED(this)) 515 515 pt => this%current_point 516 iine = INT( pt%xi + 0.5 ) 516 iine = INT( pt%xi + 0.5 ) + (nn_hls-1) 517 517 iproc = nicbflddest(mi1(iine)) 518 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN518 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 519 519 IF( iproc == ifldproc ) THEN 520 520 ! … … 592 592 DO WHILE (ASSOCIATED(this)) 593 593 pt => this%current_point 594 iine = INT( pt%xi + 0.5 ) 595 ijne = INT( pt%yj + 0.5 ) 594 iine = INT( pt%xi + 0.5 ) + (nn_hls-1) 595 ijne = INT( pt%yj + 0.5 ) + (nn_hls-1) 596 596 ipts = nicbfldpts (mi1(iine)) 597 597 iproc = nicbflddest(mi1(iine)) 598 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN598 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 599 599 IF( iproc == ifldproc ) THEN 600 600 ! -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbrst.F90
r15080 r15122 89 89 CALL iom_get( ncid, 'yj' ,localpt%yj , ktime=jn ) 90 90 91 ii = INT( localpt%xi + 0.5 ) 92 ij = INT( localpt%yj + 0.5 ) 91 ii = INT( localpt%xi + 0.5 ) + ( nn_hls-1 ) 92 ij = INT( localpt%yj + 0.5 ) + ( nn_hls-1 ) 93 93 ! Only proceed if this iceberg is on the local processor (excluding halos). 94 94 IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND. & -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbthm.F90
r14773 r15122 113 113 zyj = pt%yj 114 114 ii = INT( zxi + 0.5 ) ! T-cell of the berg 115 ii = mi1( ii )115 ii = mi1( ii + (nn_hls-1) ) 116 116 ij = INT( zyj + 0.5 ) 117 ij = mj1( ij )117 ij = mj1( ij + (nn_hls-1) ) 118 118 zVol = zT * zW * zL 119 119 … … 203 203 zLbits = MIN( zL, zW, zT, 40._wp ) ! assume bergy bits are smallest dimension or 40 meters 204 204 zAbits = ( zMbits / rn_rho_bergs ) / zLbits ! Effective bottom area (assuming T=Lbits) 205 zMbb = MAX( 0.58_wp*(zdvo **0.8_wp)*(zSST+2._wp) / &205 zMbb = MAX( 0.58_wp*(zdvob**0.8_wp)*(zSST+2._wp) / & 206 206 & ( zLbits**0.2_wp ) , 0._wp ) * z1_rday ! Basal turbulent melting (for bits) 207 207 zMbb = rn_rho_bergs * zAbits * zMbb ! in kg/s -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ICB/icbutl.F90
r14400 r15122 300 300 zwj = pj - 0.5_wp - REAL(kij,wp) 301 301 END SELECT 302 kii = kii + (nn_hls-1) 303 kij = kij + (nn_hls-1) 302 304 ! 303 305 ! compute weight … … 461 463 462 464 ! conversion to local domain (no need to do a sanity check already done in icbpos) 463 ii = mi1(ii) 464 ij = mj1(ij) 465 ii = mi1(ii) + (nn_hls-1) 466 ij = mj1(ij) + (nn_hls-1) 465 467 ! 466 468 IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfcav.F90
r15004 r15122 22 22 USE isfdiags , ONLY: isf_diags_flx ! ice shelf diags subroutine 23 23 ! 24 USE oce , ONLY: ts ! ocean tracers 24 USE oce , ONLY: ts, uu, vv, rn2 ! ocean dynamics and tracers 25 USE dom_oce ! ocean space and time domain 25 26 USE par_oce , ONLY: jpi,jpj ! ocean space and time domain 26 27 USE phycst , ONLY: grav,rho0,rho0_rcp,r1_rho0_rcp ! physical constants … … 31 32 USE fldread ! read input field at current time step 32 33 USE lbclnk ! lbclnk 34 USE lib_mpp ! MPP library 33 35 34 36 IMPLICIT NONE … … 38 40 PUBLIC isf_cav, isf_cav_init ! routine called in isfmlt 39 41 42 !! * Substitutions 43 # include "do_loop_substitute.h90" 44 # include "domzgr_substitute.h90" 40 45 !!---------------------------------------------------------------------- 41 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 71 76 !!--------------------------------------------------------------------- 72 77 LOGICAL :: lit 73 INTEGER :: nit 78 INTEGER :: nit, ji, jj, ikt 74 79 REAL(wp) :: zerr 80 REAL(wp) :: zcoef, zdku, zdkv 75 81 REAL(wp), DIMENSION(jpi,jpj) :: zqlat, zqoce, zqhc, zqh ! heat fluxes 76 REAL(wp), DIMENSION(jpi,jpj) :: zq oce_b!82 REAL(wp), DIMENSION(jpi,jpj) :: zqh_b, zRc ! 77 83 REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas ! exchange coeficient 78 84 REAL(wp), DIMENSION(jpi,jpj) :: zttbl, zstbl ! temp. and sal. in top boundary layer … … 88 94 ! 89 95 ! initialisation 90 IF (TRIM(cn_gammablk) == 'vel_stab' ) zqoce_b (:,:) = ptsc(:,:,jp_tem) * rho0_rcp ! last time step total heat fluxes (to speed up convergence) 96 IF ( TRIM(cn_gammablk) == 'vel_stab' ) THEN 97 zqoce(:,:) = -pqfwf(:,:) * rLfusisf ! 98 zqh_b(:,:) = ptsc(:,:,jp_tem) * rho0_rcp ! last time step total heat fluxes (to speed up convergence) 99 100 DO_2D( 0, 0, 0, 0 ) 101 ikt = mikt(ji,jj) 102 ! compute Rc number (as done in zdfric.F90) 103 !!gm better to do it like in the new zdfric.F90 i.e. avm weighted Ri computation 104 zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm) 105 ! ! shear of horizontal velocity 106 zdku = zcoef * ( uu(ji-1,jj ,ikt ,Kmm) + uu(ji,jj,ikt ,Kmm) & 107 & -uu(ji-1,jj ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm) ) 108 zdkv = zcoef * ( vv(ji ,jj-1,ikt ,Kmm) + vv(ji,jj,ikt ,Kmm) & 109 & -vv(ji ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm) ) 110 ! ! richardson number (minimum value set to zero) 111 zRc(ji,jj) = MAX(rn2(ji,jj,ikt+1), 1.e-20_wp) / MAX( zdku*zdku + zdkv*zdkv, 1.e-20_wp ) 112 END_2D 113 CALL lbc_lnk( 'isfmlt', zRc, 'T', 1._wp ) 114 ENDIF 91 115 ! 92 116 ! compute ice shelf melting … … 97 121 ! useless if melt specified 98 122 IF ( TRIM(cn_isfcav_mlt) .NE. 'spe' ) THEN 99 CALL isfcav_gammats( Kmm, zttbl, zstbl, zqoce , pqfwf, &123 CALL isfcav_gammats( Kmm, zttbl, zstbl, zqoce , pqfwf, zRc, & 100 124 & zgammat, zgammas ) 101 125 END IF … … 112 136 CASE ( 'vel_stab' ) 113 137 ! compute error between 2 iterations 114 zerr = MAXVAL(ABS(zqoce(:,:) - zqoce_b(:,:))) 138 zerr = 0._wp 139 DO_2D( 0, 0, 0, 0 ) 140 zerr = MAX( zerr, ABS(zqhc(ji,jj)+zqoce(ji,jj) - zqh_b(ji,jj)) ) 141 END_2D 142 CALL mpp_max( 'isfcav', zerr ) ! max over the global domain 115 143 ! 116 144 ! define if iteration needed … … 121 149 ELSE ! converge is not yet achieve 122 150 nit = nit + 1 123 zq oce_b(:,:) =zqoce(:,:)151 zqh_b(:,:) = zqhc(:,:)+zqoce(:,:) 124 152 END IF 125 153 END SELECT … … 127 155 END DO 128 156 ! 129 ! compute heat and water flux ( > 0 from isf to oce) 130 pqfwf(:,:) = pqfwf(:,:) * mskisf_cav(:,:) 131 zqoce(:,:) = zqoce(:,:) * mskisf_cav(:,:) 132 zqhc (:,:) = zqhc(:,:) * mskisf_cav(:,:) 133 ! 134 ! compute heat content flux ( > 0 from isf to oce) 135 zqlat(:,:) = - pqfwf(:,:) * rLfusisf ! 2d latent heat flux (W/m2) 136 ! 137 ! total heat flux ( > 0 from isf to oce) 138 zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) ) 139 ! 140 ! lbclnk on melt 141 CALL lbc_lnk( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 157 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 158 ! compute heat and water flux ( > 0 from isf to oce) 159 pqfwf(ji,jj) = pqfwf(ji,jj) * mskisf_cav(ji,jj) 160 zqoce(ji,jj) = zqoce(ji,jj) * mskisf_cav(ji,jj) 161 zqhc (ji,jj) = zqhc(ji,jj) * mskisf_cav(ji,jj) 162 ! 163 ! compute heat content flux ( > 0 from isf to oce) 164 zqlat(ji,jj) = - pqfwf(ji,jj) * rLfusisf ! 2d latent heat flux (W/m2) 165 ! 166 ! total heat flux ( > 0 from isf to oce) 167 zqh(ji,jj) = ( zqhc (ji,jj) + zqoce(ji,jj) ) 168 ! 169 ! set temperature content 170 ptsc(ji,jj,jp_tem) = zqh(ji,jj) * r1_rho0_rcp 171 END_2D 142 172 ! 143 173 ! output fluxes 144 174 CALL isf_diags_flx( Kmm, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, 'cav', pqfwf, zqoce, zqlat, zqhc) 145 !146 ! set temperature content147 ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp148 175 ! 149 176 ! write restart variables (qoceisf, qhcisf, fwfisf for now and before) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfcavgam.F90
r13237 r15122 14 14 USE isftbl , ONLY: isf_tbl 15 15 16 USE oce , ONLY: uu, vv , rn2 ! ocean dynamics and tracers16 USE oce , ONLY: uu, vv ! ocean dynamics 17 17 USE phycst , ONLY: grav, vkarmn ! physical constant 18 18 USE eosbn2 , ONLY: eos_rab ! equation of state … … 30 30 PUBLIC isfcav_gammats 31 31 32 !! * Substitutions 33 # include "do_loop_substitute.h90" 32 34 # include "domzgr_substitute.h90" 33 35 !!---------------------------------------------------------------------- … … 42 44 !!----------------------------------------------------------------------------------------------------- 43 45 ! 44 SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, p gt, pgs )46 SUBROUTINE isfcav_gammats( Kmm, pttbl, pstbl, pqoce, pqfwf, pRc, pgt, pgs ) 45 47 !!---------------------------------------------------------------------- 46 48 !! ** Purpose : compute the coefficient echange for heat and fwf flux … … 55 57 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pqoce, pqfwf ! isf heat and fwf 56 58 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! top boundary layer tracer 59 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pRc ! Richardson number 57 60 !!--------------------------------------------------------------------- 58 61 REAL(wp), DIMENSION(jpi,jpj) :: zutbl, zvtbl ! top boundary layer velocity … … 92 95 pgs(:,:) = rn_gammas0 93 96 CASE ( 'vel' ) ! gamma is proportional to u* 94 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r_ke0_top, pgt, pgs )97 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r_ke0_top, pgt, pgs ) 95 98 CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 96 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, p gt, pgs )99 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pRc, pgt, pgs ) 97 100 CASE DEFAULT 98 101 CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') … … 133 136 REAL(wp), INTENT(in ) :: pke2 ! background velocity 134 137 !!--------------------------------------------------------------------- 138 INTEGER :: ji, jj ! loop index 135 139 REAL(wp), DIMENSION(jpi,jpj) :: zustar 136 140 !!--------------------------------------------------------------------- 137 141 ! 138 ! compute ustar (AD15 eq. 27) 139 zustar(:,:) = SQRT( pCd(:,:) * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) * mskisf_cav(:,:) 140 ! 141 ! Compute gammats 142 pgt(:,:) = zustar(:,:) * rn_gammat0 143 pgs(:,:) = zustar(:,:) * rn_gammas0 142 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 143 ! compute ustar (AD15 eq. 27) 144 zustar(ji,jj) = SQRT( pCd(ji,jj) * ( putbl(ji,jj) * putbl(ji,jj) + pvtbl(ji,jj) * pvtbl(ji,jj) + pke2 ) ) * mskisf_cav(ji,jj) 145 ! 146 ! Compute gammats 147 pgt(ji,jj) = zustar(ji,jj) * rn_gammat0 148 pgs(ji,jj) = zustar(ji,jj) * rn_gammas0 149 END_2D 144 150 ! 145 151 ! output ustar … … 148 154 END SUBROUTINE gammats_vel 149 155 150 SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, & ! <<== in151 & pgt , pgs ) ! ==>> out gammats [m/s]156 SUBROUTINE gammats_vel_stab( Kmm, pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, pRc, & ! <<== in 157 & pgt , pgs ) ! ==>> out gammats [m/s] 152 158 !!---------------------------------------------------------------------- 153 159 !! ** Purpose : compute the coefficient echange coefficient … … 166 172 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: putbl, pvtbl ! velocity in the losch top boundary layer 167 173 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pttbl, pstbl ! tracer in the losch top boundary layer 174 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pRc ! Richardson number 168 175 !!--------------------------------------------------------------------- 169 176 INTEGER :: ji, jj ! loop index 170 177 INTEGER :: ikt ! local integer 171 178 REAL(wp) :: zdku, zdkv ! U, V shear 172 REAL(wp) :: zPr, zSc , zRc ! Prandtl, Scmidth and Richardsonnumber179 REAL(wp) :: zPr, zSc ! Prandtl and Scmidth number 173 180 REAL(wp) :: zmob, zmols ! Monin Obukov length, coriolis factor at T point 174 181 REAL(wp) :: zbuofdep, zhnu ! Bouyancy length scale, sublayer tickness … … 185 192 !!--------------------------------------------------------------------- 186 193 ! 187 ! compute ustar188 zustar(:,:) = SQRT( pCd * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) )189 !190 ! output ustar191 CALL iom_put('isfustar',zustar(:,:))192 !193 194 ! compute Pr and Sc number (eq ??) 194 195 zPr = 13.8_wp … … 200 201 ! 201 202 ! compute gamma 202 DO ji = 2, jpi 203 DO jj = 2, jpj 204 ikt = mikt(ji,jj) 205 206 IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think 207 pgt = rn_gammat0 208 pgs = rn_gammas0 209 ELSE 210 ! compute Rc number (as done in zdfric.F90) 211 !!gm better to do it like in the new zdfric.F90 i.e. avm weighted Ri computation 212 zcoef = 0.5_wp / e3w(ji,jj,ikt+1,Kmm) 213 ! ! shear of horizontal velocity 214 zdku = zcoef * ( uu(ji-1,jj ,ikt ,Kmm) + uu(ji,jj,ikt ,Kmm) & 215 & -uu(ji-1,jj ,ikt+1,Kmm) - uu(ji,jj,ikt+1,Kmm) ) 216 zdkv = zcoef * ( vv(ji ,jj-1,ikt ,Kmm) + vv(ji,jj,ikt ,Kmm) & 217 & -vv(ji ,jj-1,ikt+1,Kmm) - vv(ji,jj,ikt+1,Kmm) ) 218 ! ! richardson number (minimum value set to zero) 219 zRc = MAX(rn2(ji,jj,ikt+1), 0._wp) / MAX( zdku*zdku + zdkv*zdkv, zeps ) 220 221 ! compute bouyancy 222 zts(jp_tem) = pttbl(ji,jj) 223 zts(jp_sal) = pstbl(ji,jj) 224 zdep = gdepw(ji,jj,ikt,Kmm) 225 ! 226 CALL eos_rab( zts, zdep, zab, Kmm ) 227 ! 228 ! compute length scale (Eq ??) 229 zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) ) 230 ! 231 ! compute Monin Obukov Length 232 ! Maximum boundary layer depth (Eq ??) 233 zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp 234 ! 235 ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??) 236 zmob = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps)) 237 zmols = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt) 238 ! 239 ! compute eta* (stability parameter) (Eq ??) 240 zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp))) 241 ! 242 ! compute the sublayer thickness (Eq ??) 243 zhnu = 5 * znu / zustar(ji,jj) 244 ! 245 ! compute gamma turb (Eq ??) 246 zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) & 203 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 204 205 ikt = mikt(ji,jj) 206 207 ! compute ustar 208 zustar(ji,jj) = SQRT( pCd(ji,jj) * ( putbl(ji,jj) * putbl(ji,jj) + pvtbl(ji,jj) * pvtbl(ji,jj) + pke2 ) ) 209 210 IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think 211 pgt(ji,jj) = rn_gammat0 212 pgs(ji,jj) = rn_gammas0 213 ELSE 214 ! compute bouyancy 215 zts(jp_tem) = pttbl(ji,jj) 216 zts(jp_sal) = pstbl(ji,jj) 217 zdep = gdepw(ji,jj,ikt,Kmm) 218 ! 219 CALL eos_rab( zts, zdep, zab, Kmm ) 220 ! 221 ! compute length scale (Eq ??) 222 zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) ) 223 ! 224 ! compute Monin Obukov Length 225 ! Maximum boundary layer depth (Eq ??) 226 zhmax = gdept(ji,jj,mbkt(ji,jj),Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm) -0.001_wp 227 ! 228 ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??) 229 zmob = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps)) 230 zmols = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt) 231 ! 232 ! compute eta* (stability parameter) (Eq ??) 233 zetastar = 1._wp / ( SQRT(1._wp + MAX( 0._wp, zxsiN * zustar(ji,jj) & 234 & / MAX( 1.e-20, ABS(ff_t(ji,jj)) * zmols * pRc(ji,jj) ) ))) 235 ! 236 ! compute the sublayer thickness (Eq ??) 237 zhnu = 5 * znu / MAX( 1.e-20, zustar(ji,jj) ) 238 ! 239 ! compute gamma turb (Eq ??) 240 zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / MAX( 1.e-10, ABS(ff_t(ji,jj)) * zhnu )) & 247 241 & + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn 248 ! 249 ! compute gammats 250 pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 251 pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 252 END IF 253 END DO 254 END DO 242 ! 243 ! compute gammats 244 pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 245 pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 246 END IF 247 END_2D 248 ! output ustar 249 CALL iom_put('isfustar',zustar(:,:)) 255 250 256 251 END SUBROUTINE gammats_vel_stab -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfcpl.F90
r15062 r15122 201 201 ENDIF 202 202 END_2D 203 CALL lbc_lnk( 'isfcpl', ssh(:,:,Kmm), 'T', 1.0_wp, zssmask_b(:,:), 'T', 1.0_wp ) 203 204 ! 204 205 zssh(:,:) = ssh(:,:,Kmm) 205 206 zssmask0(:,:) = zssmask_b(:,:) 206 207 ! 207 CALL lbc_lnk( 'iscplrst', zssh, 'T', 1.0_wp, zssmask0, 'T', 1.0_wp )208 208 ! 209 209 END DO … … 359 359 END DO 360 360 ! 361 CALL lbc_lnk( 'isfcpl', ts(:,:,:,jp_tem,Kmm), 'T', 1.0_wp, ts(:,:,:,jp_sal,Kmm), 'T', 1.0_wp, ztmask1, 'T', 1.0_wp) 362 ! 361 363 ! update temperature and salinity and mask 362 364 zts0(:,:,:,:) = ts(:,:,:,:,Kmm) 363 365 ztmask0(:,:,:) = ztmask1(:,:,:) 364 366 ! 365 CALL lbc_lnk( 'iscplrst', zts0(:,:,:,jp_tem), 'T', 1.0_wp, zts0(:,:,:,jp_sal), 'T', 1.0_wp, ztmask0, 'T', 1.0_wp)366 367 ! 367 368 END DO ! nn_drown … … 437 438 & - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 438 439 & * tmask(ji,jj,jk) 440 ! 441 ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out) 442 ! correction to add is _b - _n 443 risfcpl_vol(ji,jj,jk) = zqvolb(ji,jj,jk) - zqvoln(ji,jj,jk) 439 444 END_2D 440 !441 ! 1.3: get 3d volume flux difference (before - after cpl) (>0 out)442 ! correction to add is _b - _n443 risfcpl_vol(:,:,jk) = zqvolb(:,:,jk) - zqvoln(:,:,jk)444 445 END DO 445 446 ! … … 455 456 END_2D 456 457 ! 457 CALL lbc_lnk( 'is cpl', risfcpl_vol, 'T', 1.0_wp )458 CALL lbc_lnk( 'isfcpl', risfcpl_vol, 'T', 1.0_wp ) 458 459 ! 459 460 ! 3.0: set total correction (div, tr(:,:,:,:,Krhs), ssh) … … 691 692 ! 692 693 ! add lbclnk 693 CALL lbc_lnk( 'is cplrst', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, &694 & 694 CALL lbc_lnk( 'isfcpl', risfcpl_cons_tsc(:,:,:,jp_tem), 'T', 1.0_wp, risfcpl_cons_tsc(:,:,:,jp_sal), 'T', 1.0_wp, & 695 & risfcpl_cons_vol(:,:,:) , 'T', 1.0_wp) 695 696 ! 696 697 ! ssh correction (for dynspg_ts) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ISF/isfpar.F90
r15004 r15122 30 30 USE iom ! I/O library 31 31 USE fldread ! read input field at current time step 32 USE lbclnk ! lbc_lnk33 32 34 33 IMPLICIT NONE … … 37 36 PUBLIC isf_par, isf_par_init 38 37 38 !! * Substitutions 39 # include "do_loop_substitute.h90" 39 40 !!---------------------------------------------------------------------- 40 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 67 68 INTEGER, INTENT(in) :: Kmm ! ocean time level index 68 69 !!--------------------------------------------------------------------- 70 INTEGER :: ji, jj 69 71 REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh 70 72 !!--------------------------------------------------------------------- … … 73 75 CALL isfpar_mlt( kt, Kmm, zqhc, zqoce, pqfwf ) 74 76 ! 75 ! compute heat and water flux (from isf to oce) 76 pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:) 77 zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:) 78 zqhc (:,:) = zqhc(:,:) * mskisf_par(:,:) 79 ! 80 ! compute latent heat flux (from isf to oce) 81 zqlat(:,:) = - pqfwf(:,:) * rLfusisf ! 2d latent heat flux (W/m2) 82 ! 83 ! total heat flux (from isf to oce) 84 zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) ) 85 ! 86 ! lbclnk on melt and heat fluxes 87 CALL lbc_lnk( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp) 77 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 78 ! compute heat and water flux (from isf to oce) 79 pqfwf(ji,jj) = pqfwf(ji,jj) * mskisf_par(ji,jj) 80 zqoce(ji,jj) = zqoce(ji,jj) * mskisf_par(ji,jj) 81 zqhc (ji,jj) = zqhc(ji,jj) * mskisf_par(ji,jj) 82 ! 83 ! compute latent heat flux (from isf to oce) 84 zqlat(ji,jj) = - pqfwf(ji,jj) * rLfusisf ! 2d latent heat flux (W/m2) 85 ! 86 ! total heat flux (from isf to oce) 87 zqh(ji,jj) = ( zqhc (ji,jj) + zqoce(ji,jj) ) 88 ! 89 ! set temperature content 90 ptsc(ji,jj,jp_tem) = zqh(ji,jj) * r1_rho0_rcp 91 END_2D 88 92 ! 89 93 ! output fluxes 90 94 CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc) 91 !92 ! set temperature content93 ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp94 95 ! 95 96 ! write restart variables (qoceisf, qhcisf, fwfisf for now and before) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/LDF/ldftra.F90
r15095 r15122 615 615 DO jk = 1, jpkm1 616 616 aeiu(:,:,jk) = aeiu(:,:,jk) * umask(:,:,jk) 617 a htv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk)617 aeiv(:,:,jk) = aeiv(:,:,jk) * vmask(:,:,jk) 618 618 END DO 619 619 ENDIF … … 755 755 CALL ctl_stop('ldf_eiv: Unrecognised option for nn_ldfeiv_shape.') 756 756 END SELECT 757 CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )! lateral boundary condition758 ! 759 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1)757 IF( nn_hls == 1 ) CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp ) ! lateral boundary condition 758 ! 759 DO_2D( 0, 0, 0, 0 ) 760 760 paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj ) ) * umask(ji,jj,1) 761 761 paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji ,jj+1) ) * vmask(ji,jj,1) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/SBC/sbcblk_algo_ice_an05.F90
r14072 r15122 267 267 268 268 !! *** TABLE 1 of Andreas et al. 2005 *** 269 !! Smooth flow condition (R* <= 0.135): 270 zsmoot = 0.5_wp + SIGN( 0.5_wp, (0.135_wp - zre) ) ! zre <= 0.135: zsmoot==1 ; otherwize: zsmoot==0 271 !! Transition (0.135 < R* < 2.5): 272 ztrans = 0.5_wp + SIGN( 0.5_wp, (2.49999_wp - zre) ) - zsmoot 273 !! Rough ( R* > 2.5): 274 zrough = 0.5_wp + SIGN( 0.5_wp, (zre - 2.5_wp) ) 275 276 IF( (zsmoot+ztrans+zrough > 1.001_wp).OR.(zsmoot+ztrans+zrough < 0.999_wp) ) & 277 CALL ctl_stop( ' rough_leng_tq@mod_blk_ice_an05.f90 => something wrong with zsmoot, ztrans, zrough!' ) 278 269 zsmoot = 0._wp ; ztrans = 0._wp ; zrough = 0._wp 270 IF ( zre <= 0.135_wp ) THEN ! Smooth flow condition (R* <= 0.135): 271 zsmoot = 1._wp 272 ELSEIF( zre < 2.5_wp ) THEN ! Transition (0.135 < R* < 2.5) 273 ztrans = 1._wp 274 ELSE ! Rough ( R* > 2.5) 275 zrough = 1._wp 276 ENDIF 277 279 278 zlog = LOG(zre) 280 279 zlog2 = zlog*zlog -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/SBC/sbcblk_algo_ice_cdn.F90
r14072 r15122 35 35 !!============================================================ 36 36 REAL(wp), PARAMETER :: rce10_i_0 = 3.46e-3_wp ! (Eq.48) MIZ 37 38 37 REAL(wp), PARAMETER :: ralpha_0 = 0.2_wp ! (Eq.12) (ECHAM6 value) 39 38 … … 61 60 !! 62 61 !!---------------------------------------------------------------------- 63 REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU12 ! neutral FORM drag coefficient contribution over sea-ice64 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc, phf and pDi all provided...65 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m]66 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)67 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]68 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]69 !!---------------------------------------------------------------------- 70 LOGICAL ::l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE.71 REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi72 INTEGER :: ji, jj62 REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU12 ! neutral FORM drag coefficient contribution over sea-ice 63 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc, phf and pDi all provided... 64 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m] 65 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) 66 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m] 67 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m] 68 !!---------------------------------------------------------------------- 69 LOGICAL :: l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. 70 REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi 71 INTEGER :: ji, jj 73 72 !!---------------------------------------------------------------------- 74 73 l_known_Sc = PRESENT(pSc) … … 78 77 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 79 78 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 CdN10_f_LU12(:,:) = 0.5_wp* 0.3_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri ! Eq.(22)109 !!1/2 Ce79 zfri = pfrice(ji,jj) 80 zfrw = (1._wp - zfri) 81 82 IF(l_known_Sc) THEN 83 zSc = pSc(ji,jj) 84 ELSE 85 !! Sc parameterized in terms of A (ice fraction): 86 zSc = zfrw**(1._wp / ( 10._wp * rBeta_0 )) ! Eq.(31) 87 END IF 88 89 IF(l_known_hf) THEN 90 zhf = phf(ji,jj) 91 ELSE 92 !! hf parameterized in terms of A (ice fraction): 93 zhf = rhmax_0*zfri + rhmin_0*zfrw ! Eq.(25) 94 END IF 95 96 IF(l_known_Di) THEN 97 zDi = pDi(ji,jj) 98 ELSE 99 !! Di parameterized in terms of A (ice fraction): 100 ztmp = 1._wp / ( 1._wp - (rDmin_0/rDmax_0)**(1._wp/rBeta_0) ) ! A* Eq.(27) 101 zDi = rDmin_0 * ( ztmp/(ztmp - zfri) )**rBeta_0 ! Eq.(26) 102 END IF 103 104 ztmp = 1._wp/pz0w(ji,jj) 105 zrlog = LOG(zhf*ztmp) / LOG(10._wp*ztmp) 106 107 CdN10_f_LU12(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri ! Eq.(22) 108 !! 1/2 Ce 110 109 111 110 END_2D … … 114 113 115 114 FUNCTION CdN_f_LU12_eq36( pzu, pfrice ) 116 REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice 117 REAL(wp), INTENT(in) :: pzu ! reference height [m] 118 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc, phf and pDi all provided... 115 !!---------------------------------------------------------------------- 116 REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LU12_eq36 ! neutral FORM drag coefficient contribution over sea-ice 117 REAL(wp), INTENT(in) :: pzu ! reference height [m] 118 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc, phf and pDi all provided... 119 119 !!---------------------------------------------------------------------- 120 120 REAL(wp) :: ztmp, zrlog, zfri, zhf, zDi … … 129 129 130 130 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 131 132 zfri = pfrice(ji,jj) 133 134 CdN_f_LU12_eq36(:,:) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36) 135 !! 1/2 Ce 131 zfri = pfrice(ji,jj) 132 CdN_f_LU12_eq36(ji,jj) = 0.5_wp* 0.3_wp * zrlog*zrlog * zhf/zDi * (1._wp - zfri)**rBeta_0 ! Eq.(35) & (36) 133 !! 1/2 Ce 136 134 END_2D 137 135 END FUNCTION CdN_f_LU12_eq36 138 139 140 136 141 137 … … 172 168 !! 173 169 !!---------------------------------------------------------------------- 174 REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU13 ! neutral FORM drag coefficient contribution over sea-ice175 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b176 177 !!----------------------------------------------------------------------178 REAL(wp) 170 REAL(wp), DIMENSION(jpi,jpj) :: CdN10_f_LU13 ! neutral FORM drag coefficient contribution over sea-ice 171 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b 172 !!---------------------------------------------------------------------- 173 INTEGER :: ji, jj 174 REAL(wp) :: zcoef 179 175 !!---------------------------------------------------------------------- 180 176 zcoef = rNu_0 + 1._wp / ( 10._wp * rBeta_0 ) … … 183 179 !! => so we keep only the last rhs terms of Eq.(1) of Lupkes et al, 2013 that we divide by "A": 184 180 !! (we multiply Cd_i_s and Cd_i_f by A later, when applying ocean-ice partitioning... 185 186 CdN10_f_LU13(:,:) = rCe_0 * pfrice(:,:)**(rMu_0 - 1._wp) * (1._wp - pfrice(:,:))**zcoef 181 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 182 CdN10_f_LU13(ji,jj) = rCe_0 * pfrice(ji,jj)**(rMu_0 - 1._wp) * (1._wp - pfrice(ji,jj))**zcoef 183 END_2D 187 184 !! => seems okay for winter 100% sea-ice as second rhs term vanishes as pfrice == 1.... 188 185 … … 207 204 !! 208 205 !!---------------------------------------------------------------------- 209 REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15 ! neutral FORM drag coefficient contribution over sea-ice210 REAL(wp), INTENT(in ) :: pzu ! reference height [m]211 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc, phf and pDi all provided...212 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0i ! roughness length over ICE [m] (in LU12, it's over water ???)213 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances)214 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m]215 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m]216 !!---------------------------------------------------------------------- 217 LOGICAL ::l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE.218 REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi219 INTEGER :: ji, jj206 REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15 ! neutral FORM drag coefficient contribution over sea-ice 207 REAL(wp), INTENT(in ) :: pzu ! reference height [m] 208 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b ! NOT USED if pSc, phf and pDi all provided... 209 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0i ! roughness length over ICE [m] (in LU12, it's over water ???) 210 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pSc ! shletering function [0-1] (Sc->1 for large distance between floes, ->0 for small distances) 211 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: phf ! mean freeboard of floes [m] 212 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: pDi ! cross wind dimension of the floe (aka effective edge length for form drag) [m] 213 !!---------------------------------------------------------------------- 214 LOGICAL :: l_known_Sc=.FALSE., l_known_hf=.FALSE., l_known_Di=.FALSE. 215 REAL(wp) :: ztmp, zrlog, zfri, zfrw, zSc, zhf, zDi 216 INTEGER :: ji, jj 220 217 !!---------------------------------------------------------------------- 221 218 l_known_Sc = PRESENT(pSc) … … 225 222 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 226 223 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 CdN_f_LG15(:,:) = 0.5_wp* 0.4_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri ! Eq.(21) Lukes & Gryanik (2015)256 257 224 zfri = pfrice(ji,jj) 225 zfrw = (1._wp - zfri) 226 227 IF(l_known_Sc) THEN 228 zSc = pSc(ji,jj) 229 ELSE 230 !! Sc parameterized in terms of A (ice fraction): 231 zSc = zfrw**(1._wp / ( 10._wp * rBeta_0 )) ! Eq.(31) 232 END IF 233 234 IF(l_known_hf) THEN 235 zhf = phf(ji,jj) 236 ELSE 237 !! hf parameterized in terms of A (ice fraction): 238 zhf = rhmax_0*zfri + rhmin_0*zfrw ! Eq.(25) 239 END IF 240 241 IF(l_known_Di) THEN 242 zDi = pDi(ji,jj) 243 ELSE 244 !! Di parameterized in terms of A (ice fraction): 245 ztmp = 1._wp / ( 1._wp - (rDmin_0/rDmax_0)**(1._wp/rBeta_0) ) ! A* Eq.(27) 246 zDi = rDmin_0 * ( ztmp/(ztmp - zfri) )**rBeta_0 ! Eq.(26) 247 END IF 248 249 ztmp = 1._wp/pz0i(ji,jj) 250 zrlog = LOG(zhf*ztmp/2.718_wp) / LOG(pzu*ztmp) !LOLO: adding number "e" !!! 251 252 CdN_f_LG15(ji,jj) = 0.5_wp* 0.4_wp * zrlog*zrlog * zSc*zSc * zhf/zDi * zfri ! Eq.(21) Lukes & Gryanik (2015) 253 !! 1/2 Ce 254 258 255 END_2D 259 256 END FUNCTION CdN_f_LG15 260 257 261 258 262 263 259 FUNCTION CdN_f_LG15_light( pzu, pfrice, pz0w ) 264 260 !!---------------------------------------------------------------------- … … 275 271 !! 276 272 !!---------------------------------------------------------------------- 277 REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15_light ! neutral FORM drag coefficient contribution over sea-ice278 REAL(wp), INTENT(in) :: pzu ! reference height [m]279 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b280 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m]281 !!---------------------------------------------------------------------- 282 REAL(wp) :: ztmp, zrlog, zfri283 INTEGER :: ji, jj284 !!---------------------------------------------------------------------- 285 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 286 287 288 289 290 291 292 CdN_f_LG15_light(:,:) = rce10_i_0 *zrlog*zrlog * zfri * (1._wp - zfri)**rbeta_0 ! (Eq.46) [ index 1 is for ice, 2 for water ]273 REAL(wp), DIMENSION(jpi,jpj) :: CdN_f_LG15_light ! neutral FORM drag coefficient contribution over sea-ice 274 REAL(wp), INTENT(in) :: pzu ! reference height [m] 275 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfrice ! ice concentration [fraction] => at_i_b 276 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pz0w ! roughness length over water [m] 277 !!---------------------------------------------------------------------- 278 REAL(wp) :: ztmp, zrlog, zfri 279 INTEGER :: ji, jj 280 !!---------------------------------------------------------------------- 281 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 282 283 zfri = pfrice(ji,jj) 284 285 ztmp = 1._wp / pz0w(ji,jj) 286 zrlog = LOG( 10._wp * ztmp ) / LOG( pzu * ztmp ) ! part of (Eq.46) 287 288 CdN_f_LG15_light(ji,jj) = rce10_i_0 *zrlog*zrlog * zfri * (1._wp - zfri)**rbeta_0 ! (Eq.46) [ index 1 is for ice, 2 for water ] 293 289 294 290 END_2D 295 291 END FUNCTION CdN_f_LG15_light 296 297 292 298 293 -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OCE/ZDF/zdfmxl.F90
r15095 r15122 493 493 ! w-level of the turbocline and mixing layer (iom_use) 494 494 imld(:,:) = mbkt(A2D(nn_hls)) + 1 ! Initialization to the number of w ocean point 495 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10495 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 496 496 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 497 497 END_3D 498 498 ! depth of the mixing layer 499 DO_2D_OVR( 1, 1, 1, 1)499 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 500 500 iik = imld(ji,jj) 501 501 hmld (ji,jj) = gdepw(ji,jj,iik ,Kmm) * ssmask(ji,jj) ! Turbocline depth -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/OFF/dtadyn.F90
r15023 r15122 419 419 gdepw(:,:,1,Kmm) = 0.0_wp 420 420 ! 421 DO_3D( 1, 1, 1, 1, 2, jpk )421 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 422 422 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 423 423 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) … … 503 503 ! 504 504 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 505 DO_2D( 1, 1, 1, 1)505 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 506 506 IF( h_rnf(ji,jj) > 0._wp ) THEN 507 507 jk = 2 … … 517 517 END_2D 518 518 ! 519 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 519 ! set the associated depth 520 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 520 521 h_rnf(ji,jj) = 0._wp 521 522 DO jk = 1, nk_rnf(ji,jj) … … 552 553 !!---------------------------------------------------------------------- 553 554 ! 554 DO_2D( 1, 1, 1, 1 ) ! update the depth over which runoffs are distributed 555 ! update the depth over which runoffs are distributed 556 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 555 557 h_rnf(ji,jj) = 0._wp 556 558 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/C14/trcsms_c14.F90
r13970 r15122 81 81 ! ------------------------------------------------------------------- 82 82 83 DO_2D( 1, 1, 1, 1)83 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 84 84 IF( tmask(ji,jj,1) > 0. ) THEN 85 85 ! … … 128 128 ! 129 129 ! Add the surface flux to the trend of jp_c14 130 DO_2D( 1, 1, 1, 1)130 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 131 131 tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm) 132 132 END_2D 133 133 ! 134 134 ! Computation of decay effects on jp_c14 135 DO_3D( 1, 1, 1, 1, 1, jpk )135 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 136 136 ! 137 137 tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/C14/trcwri_c14.F90
r14239 r15122 60 60 zz3d(:,:,:) = 0._wp 61 61 ! 62 DO_3D( 1, 1, 1, 1, 1, jpkm1 )62 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 63 63 IF( tmask(ji,jj,jk) > 0._wp) THEN 64 64 z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) … … 71 71 z2d(:,:) =0._wp 72 72 jk = 1 73 DO_2D( 1, 1, 1, 1)73 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 74 74 ztemp = zres(ji,jj) / c14sbc(ji,jj) 75 75 IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/CFC/trcini_cfc.F90
r13295 r15122 132 132 !--------------------------------------------------------------------------------------- 133 133 zyd = ylatn - ylats 134 DO_2D( 1, 1, 1, 1)134 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 135 135 IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0 136 136 ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0 -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/CFC/trcsms_cfc.F90
r13497 r15122 126 126 127 127 ! !------------! 128 DO_2D( 1, 1, 1, 1 )! i-j loop !128 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! i-j loop ! 129 129 ! !------------! 130 130 ! space interpolation -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P2Z/p2zexp.F90
r13295 r15122 121 121 ELSE 122 122 ! 123 DO_2D( 1, 1, 1, 1)123 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 124 124 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) ! time laplacian on tracers 125 125 sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd ! sedpocb <-- filtered sedpocn … … 174 174 zdm0 = 0._wp 175 175 zrro = 1._wp 176 DO_3D( 1, 1, 1, 1, jpkb, jpkm1 )176 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, jpkb, jpkm1 ) 177 177 zfluo = ( gdepw(ji,jj,jk ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 178 178 zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr … … 191 191 dminl(:,:) = 0._wp 192 192 dmin3(:,:,:) = zdm0 193 DO_3D( 1, 1, 1, 1, 1, jpk )193 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 194 194 IF( tmask(ji,jj,jk) == 0._wp ) THEN 195 195 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) … … 198 198 END_3D 199 199 200 DO_2D( 1, 1, 1, 1)200 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 201 201 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0._wp 202 202 END_2D -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P2Z/p2zopt.F90
r13497 r15122 95 95 ! ! Photosynthetically Available Radiation (PAR) 96 96 zcoef = 12 * redf / rcchl / rpig ! -------------------------------------- 97 DO_3D( 1, 1, 1, 1, 2, jpk ) ! local par at w-levels97 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 98 98 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef ) 99 99 zkr = xkr0 + xkrp * EXP( xlr * zpig ) … … 102 102 zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) ) 103 103 END_3D 104 DO_3D( 1, 1, 1, 1, 1, jpkm1 )! mean par at t-levels104 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) ! mean par at t-levels 105 105 zpig = LOG( MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef ) 106 106 zkr = xkr0 + xkrp * EXP( xlr * zpig ) … … 114 114 ! ! -------------- 115 115 neln(:,:) = 1 ! euphotic layer level 116 DO_3D( 1, 1, 1, 1, 1, jpkm1 )! (i.e. 1rst T-level strictly below EL bottom)116 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) ! (i.e. 1rst T-level strictly below EL bottom) 117 117 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 118 118 END_3D 119 119 ! ! Euphotic layer depth 120 DO_2D( 1, 1, 1, 1 )120 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 121 121 heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm) 122 122 END_2D -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P2Z/p2zsed.F90
r13295 r15122 89 89 90 90 ! tracer flux divergence at t-point added to the general trend 91 DO_3D( 1, 1, 1, 1, 1, jpkm1 )91 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 92 92 ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 93 93 tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zagg.F90
r13295 r15122 60 60 IF( ln_p4z ) THEN 61 61 ! 62 DO_3D( 1, 1, 1, 1, 1, jpkm1 )62 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 63 63 ! 64 64 zfact = xstep * xdiss(ji,jj,jk) … … 102 102 ELSE ! ln_p5z 103 103 ! 104 DO_3D( 1, 1, 1, 1, 1, jpkm1 )104 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 105 105 ! 106 106 zfact = xstep * xdiss(ji,jj,jk) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zbc.F90
r13295 r15122 112 112 IF( ll_river ) THEN 113 113 jl = n_trc_indcbc(jpno3) 114 DO_2D( 1, 1, 1, 1)114 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 115 115 DO jk = 1, nk_rnf(ji,jj) 116 116 zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1) … … 145 145 ALLOCATE( zironice(jpi,jpj) ) 146 146 ! 147 DO_2D( 1, 1, 1, 1)147 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 148 148 zdep = rfact / e3t(ji,jj,1,Kmm) 149 149 zwflux = fmmflx(ji,jj) / 1000._wp … … 313 313 CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1.0_wp ) ! lateral boundary conditions on cmask (sign unchanged) 314 314 ! 315 DO_3D( 1, 1, 1, 1, 1, jpk )315 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 316 316 zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) ) 317 317 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zbio.F90
r13295 r15122 72 72 xdiss(:,:,:) = 1. 73 73 !!gm the use of nmld should be better here? 74 DO_3D( 1, 1, 1, 1, 2, jpkm1 )74 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) 75 75 !!gm : use nmln and test on jk ... less memory acces 76 76 IF( gdepw(ji,jj,jk+1,Kmm) > hmld(ji,jj) ) xdiss(ji,jj,jk) = 0.01 -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zche.F90
r14086 r15122 179 179 ! 0.04°C relative to an exact computation 180 180 ! --------------------------------------------------------------------- 181 DO_3D( 1, 1, 1, 1, 1, jpk )181 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 182 182 zpres = gdept(ji,jj,jk,Kmm) / 1000. 183 183 za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) … … 188 188 ! CHEMICAL CONSTANTS - SURFACE LAYER 189 189 ! ---------------------------------- 190 DO_2D( 1, 1, 1, 1)190 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 191 191 ! ! SET ABSOLUTE TEMPERATURE 192 192 ztkel = tempis(ji,jj,1) + 273.15 … … 204 204 ! OXYGEN SOLUBILITY - DEEP OCEAN 205 205 ! ------------------------------- 206 DO_3D( 1, 1, 1, 1, 1, jpk )206 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 207 207 ztkel = tempis(ji,jj,jk) + 273.15 208 208 zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. … … 223 223 ! CHEMICAL CONSTANTS - DEEP OCEAN 224 224 ! ------------------------------- 225 DO_3D( 1, 1, 1, 1, 1, jpk )225 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 226 226 ! SET PRESSION ACCORDING TO SAUNDER (1980) 227 227 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) … … 451 451 IF( ln_timing ) CALL timing_start('ahini_for_at') 452 452 ! 453 DO_3D( 1, 1, 1, 1, 1, jpk )453 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 454 454 p_alkcb = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 455 455 p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) … … 549 549 550 550 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 551 DO_3D( 1, 1, 1, 1, 1, jpk )551 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 552 552 IF (rmask(ji,jj,jk) == 1.) THEN 553 553 p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) … … 578 578 579 579 DO jn = 1, jp_maxniter_atgen 580 DO_3D( 1, 1, 1, 1, 1, jpk )580 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 581 581 IF (rmask(ji,jj,jk) == 1.) THEN 582 582 zfact = rhop(ji,jj,jk) / 1000. + rtrn -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zfechem.F90
r13472 r15122 92 92 ! Chemistry is supposed to be fast enough to be at equilibrium 93 93 ! ------------------------------------------------------------ 94 DO_3D( 1, 1, 1, 1, 1, jpkm1)94 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 95 95 zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 96 96 zkeq = fekeq(ji,jj,jk) … … 107 107 108 108 zdust = 0. ! if no dust available 109 DO_3D( 1, 1, 1, 1, 1, jpkm1)109 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 110 110 ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 111 111 ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). … … 173 173 IF( ln_ligand ) THEN 174 174 ! 175 DO_3D( 1, 1, 1, 1, 1, jpkm1)175 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 176 176 zlam1a = ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * xdiss(ji,jj,jk) & 177 177 & + ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zflx.F90
r13295 r15122 110 110 IF( l_co2cpl ) satmco2(:,:) = atm_co2(:,:) 111 111 112 DO_2D( 1, 1, 1, 1)112 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 113 113 ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 114 114 zfact = rhop(ji,jj,1) / 1000. + rtrn … … 126 126 ! ------------------------------------------- 127 127 128 DO_2D( 1, 1, 1, 1)128 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 129 129 ztc = MIN( 35., ts(ji,jj,1,jp_tem,Kmm) ) 130 130 ztc2 = ztc * ztc … … 145 145 146 146 147 DO_2D( 1, 1, 1, 1)147 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 148 148 ztkel = tempis(ji,jj,1) + 273.15 149 149 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zint.F90
r14086 r15122 50 50 ! Computation of the silicon dependant half saturation constant for silica uptake 51 51 ! --------------------------------------------------- 52 DO_2D( 1, 1, 1, 1)52 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 53 53 zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 54 54 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zligand.F90
r13295 r15122 52 52 IF( ln_timing ) CALL timing_start('p4z_ligand') 53 53 ! 54 DO_3D( 1, 1, 1, 1, 1, jpkm1)54 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 55 55 ! 56 56 ! ------------------------------------------------------------------ -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zlim.F90
r13434 r15122 98 98 IF( ln_timing ) CALL timing_start('p4z_lim') 99 99 ! 100 DO_3D( 1, 1, 1, 1, 1, jpkm1)100 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 101 101 102 102 ! Tuning of the iron concentration to a minimum level that is set to the detection limit … … 173 173 ! Compute the fraction of nanophytoplankton that is made of calcifiers 174 174 ! -------------------------------------------------------------------- 175 DO_3D( 1, 1, 1, 1, 1, jpkm1)175 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 176 176 zlim1 = ( tr(ji,jj,jk,jpno3,Kbb) * concnnh4 + tr(ji,jj,jk,jpnh4,Kbb) * concnno3 ) & 177 177 & / ( concnno3 * concnnh4 + concnnh4 * tr(ji,jj,jk,jpno3,Kbb) + concnno3 * tr(ji,jj,jk,jpnh4,Kbb) ) … … 193 193 END_3D 194 194 ! 195 DO_3D( 1, 1, 1, 1, 1, jpkm1)195 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 196 196 ! denitrification factor computed from O2 levels 197 197 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zlys.F90
r13295 r15122 74 74 75 75 CALL solve_at_general( zhinit, zhi, Kbb ) 76 77 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 76 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 78 77 zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2 & 79 78 & + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) … … 87 86 ! --------------------------------------------------------- 88 87 89 DO_3D( 1, 1, 1, 1, 1, jpkm1)88 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 90 89 91 90 ! DEVIATION OF [CO3--] FROM SATURATION VALUE -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zmeso.F90
r13295 r15122 81 81 IF( ln_timing ) CALL timing_start('p4z_meso') 82 82 ! 83 DO_3D( 1, 1, 1, 1, 1, jpkm1)83 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 84 84 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 85 85 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zmicro.F90
r13295 r15122 79 79 IF( ln_timing ) CALL timing_start('p4z_micro') 80 80 ! 81 DO_3D( 1, 1, 1, 1, 1, jpkm1)81 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 82 82 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 83 83 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zmort.F90
r13295 r15122 77 77 ! 78 78 prodcal(:,:,:) = 0._wp ! calcite production variable set to zero 79 DO_3D( 1, 1, 1, 1, 1, jpkm1)79 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 80 80 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 ) 81 81 ! When highly limited by macronutrients, very small cells … … 152 152 ! ------------------------------------------------------------ 153 153 154 DO_3D( 1, 1, 1, 1, 1, jpkm1)154 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 155 155 156 156 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zopt.F90
r14213 r15122 85 85 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 86 86 ! 87 DO_3D( 1, 1, 1, 1, 1, jpkm1)87 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 88 88 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 89 89 zchl = MIN( 10. , MAX( 0.05, zchl ) ) … … 156 156 heup_01(:,:) = gdepw(:,:,2,Kmm) 157 157 158 DO_3D( 1, 1, 1, 1, 2, nksr)158 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr) 159 159 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 160 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer … … 174 174 zetmp2 (:,:) = 0.e0 175 175 176 DO_3D( 1, 1, 1, 1, 1, nksr)176 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 177 177 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 178 178 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation … … 185 185 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 186 186 ! 187 DO_3D( 1, 1, 1, 1, 1, nksr)187 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 188 188 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 189 189 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 197 197 zetmp4 (:,:) = 0.e0 198 198 ! 199 DO_3D( 1, 1, 1, 1, 1, nksr)199 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 200 200 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 201 201 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 207 207 ediatm(:,:,:) = ediat(:,:,:) 208 208 ! 209 DO_3D( 1, 1, 1, 1, 1, nksr)209 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 210 210 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 211 211 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 217 217 IF( ln_p5z ) THEN 218 218 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 219 DO_3D( 1, 1, 1, 1, 1, nksr)219 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 220 220 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 221 221 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 225 225 epicom(:,:,:) = epico(:,:,:) 226 226 ! 227 DO_3D( 1, 1, 1, 1, 1, nksr)227 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr) 228 228 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 229 229 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 300 300 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 301 301 ! 302 DO_3D( 1, 1, 1, 1, 2, nksr)302 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr) 303 303 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 304 304 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zpoc.F90
r13295 r15122 107 107 ! ----------------------------------------------------------------------- 108 108 ztremint(:,:,:) = zremigoc(:,:,:) 109 DO_3D( 1, 1, 1, 1, 2, jpkm1)109 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 110 110 IF (tmask(ji,jj,jk) == 1.) THEN 111 111 zdep = hmld(ji,jj) … … 192 192 193 193 IF( ln_p4z ) THEN 194 DO_3D( 1, 1, 1, 1, 1, jpkm1)194 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 195 195 ! POC disaggregation by turbulence and bacterial activity. 196 196 ! -------------------------------------------------------- … … 212 212 END_3D 213 213 ELSE 214 DO_3D( 1, 1, 1, 1, 1, jpkm1)214 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 215 215 ! POC disaggregation by turbulence and bacterial activity. 216 216 ! -------------------------------------------------------- … … 260 260 ! ---------------------------------------------------------------- 261 261 ! 262 DO_3D( 1, 1, 1, 1, 1, jpkm1)262 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 263 263 zdep = hmld(ji,jj) 264 264 IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN … … 275 275 ! --------------------------------------------------------------------- 276 276 ztremint(:,:,:) = zremipoc(:,:,:) 277 DO_3D( 1, 1, 1, 1, 1, jpkm1)277 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 278 278 IF (tmask(ji,jj,jk) == 1.) THEN 279 279 zdep = hmld(ji,jj) … … 310 310 ! ----------------------------------------------------------------------- 311 311 ! 312 DO_3D( 1, 1, 1, 1, 2, jpkm1)312 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1) 313 313 IF (tmask(ji,jj,jk) == 1.) THEN 314 314 zdep = hmld(ji,jj) … … 384 384 385 385 IF( ln_p4z ) THEN 386 DO_3D( 1, 1, 1, 1, 1, jpkm1)386 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 387 387 IF (tmask(ji,jj,jk) == 1.) THEN 388 388 ! POC disaggregation by turbulence and bacterial activity. … … 401 401 END_3D 402 402 ELSE 403 DO_3D( 1, 1, 1, 1, 1, jpkm1)403 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 404 404 ! POC disaggregation by turbulence and bacterial activity. 405 405 ! -------------------------------------------------------- -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zprod.F90
r13295 r15122 110 110 ! day length in hours 111 111 zstrn(:,:) = 0. 112 DO_2D( 1, 1, 1, 1)112 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 113 113 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 114 114 zargu = MAX( -1., MIN( 1., zargu ) ) … … 117 117 118 118 ! Impact of the day duration and light intermittency on phytoplankton growth 119 DO_3D( 1, 1, 1, 1, 1, jpkm1)119 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 120 120 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 121 121 zval = MAX( 1., zstrn(ji,jj) ) … … 135 135 136 136 ! Computation of the P-I slope for nanos and diatoms 137 DO_3D( 1, 1, 1, 1, 1, jpkm1)137 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 138 138 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 139 139 ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. ) … … 150 150 END_3D 151 151 152 DO_3D( 1, 1, 1, 1, 1, jpkm1)152 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 153 153 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 154 154 ! Computation of production function for Carbon … … 171 171 ! Computation of a proxy of the N/C ratio 172 172 ! --------------------------------------- 173 DO_3D( 1, 1, 1, 1, 1, jpkm1)173 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 174 174 zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) ) & 175 175 & * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) … … 181 181 182 182 183 DO_3D( 1, 1, 1, 1, 1, jpkm1)183 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 184 184 185 185 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN … … 205 205 ! Sea-ice effect on production 206 206 207 DO_3D( 1, 1, 1, 1, 1, jpkm1)207 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 208 208 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 209 209 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) … … 211 211 212 212 ! Computation of the various production terms 213 DO_3D( 1, 1, 1, 1, 1, jpkm1)213 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 214 214 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 215 215 ! production terms for nanophyto. (C) … … 237 237 238 238 ! Computation of the chlorophyll production terms 239 DO_3D( 1, 1, 1, 1, 1, jpkm1)239 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 240 240 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 241 241 ! production terms for nanophyto. ( chlorophyll ) … … 260 260 261 261 ! Update the arrays TRA which contain the biological sources and sinks 262 DO_3D( 1, 1, 1, 1, 1, jpkm1)262 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 263 263 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 264 264 zproreg = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) … … 288 288 IF( ln_ligand ) THEN 289 289 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 290 DO_3D( 1, 1, 1, 1, 1, jpkm1)290 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 291 291 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 292 292 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zrem.F90
r13295 r15122 89 89 ! that was modeling explicitely bacteria 90 90 ! ------------------------------------------------------- 91 DO_3D( 1, 1, 1, 1, 1, jpkm1)91 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 92 92 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 93 93 IF( gdept(ji,jj,jk,Kmm) < zdep ) THEN … … 103 103 104 104 IF( ln_p4z ) THEN 105 DO_3D( 1, 1, 1, 1, 1, jpkm1)105 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 106 106 ! DOC ammonification. Depends on depth, phytoplankton biomass 107 107 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. … … 134 134 END_3D 135 135 ELSE 136 DO_3D( 1, 1, 1, 1, 1, jpkm1)136 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 137 137 ! DOC ammonification. Depends on depth, phytoplankton biomass 138 138 ! and a limitation term which is supposed to be a parameterization of the bacterial activity. … … 178 178 179 179 180 DO_3D( 1, 1, 1, 1, 1, jpkm1)180 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 181 181 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 182 182 ! below 2 umol/L. Inhibited at strong light … … 200 200 ENDIF 201 201 202 DO_3D( 1, 1, 1, 1, 1, jpkm1)202 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 203 203 204 204 ! Bacterial uptake of iron. No iron is available in DOC. So … … 226 226 ! --------------------------------------------------------------- 227 227 228 DO_3D( 1, 1, 1, 1, 1, jpkm1)228 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 229 229 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 230 230 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - tr(ji,jj,jk,jpsil,Kbb) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zsed.F90
r13546 r15122 94 94 ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 95 95 ! -------------------------------------------------------------------- 96 DO_2D( 1, 1, 1, 1)96 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 97 97 ikt = mbkt(ji,jj) 98 98 zdep = e3t(ji,jj,ikt,Kmm) / xstep … … 104 104 ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 105 105 ! ------------------------------------------------------- 106 DO_2D( 1, 1, 1, 1)106 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 107 107 IF( tmask(ji,jj,1) == 1 ) THEN 108 108 ikt = mbkt(ji,jj) … … 130 130 IF( .NOT.lk_sed ) zrivsil = 1._wp - sedsilfrac 131 131 132 DO_2D( 1, 1, 1, 1)132 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 133 133 ikt = mbkt(ji,jj) 134 134 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 142 142 ! 143 143 IF( .NOT.lk_sed ) THEN 144 DO_2D( 1, 1, 1, 1)144 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 145 145 ikt = mbkt(ji,jj) 146 146 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 160 160 ENDIF 161 161 ! 162 DO_2D( 1, 1, 1, 1)162 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 163 163 ikt = mbkt(ji,jj) 164 164 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 172 172 ! 173 173 IF( ln_p5z ) THEN 174 DO_2D( 1, 1, 1, 1)174 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 175 175 ikt = mbkt(ji,jj) 176 176 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 187 187 ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after 188 188 ! denitrification in the sediments. Not very clever, but simpliest option. 189 DO_2D( 1, 1, 1, 1)189 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 190 190 ikt = mbkt(ji,jj) 191 191 zdep = xstep / e3t(ji,jj,ikt,Kmm) … … 224 224 ENDDO 225 225 IF( ln_p4z ) THEN 226 DO_3D( 1, 1, 1, 1, 1, jpkm1)226 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 227 227 ! ! Potential nitrogen fixation dependant on temperature and iron 228 228 ztemp = ts(ji,jj,jk,jp_tem,Kmm) … … 240 240 END_3D 241 241 ELSE ! p5z 242 DO_3D( 1, 1, 1, 1, 1, jpkm1)242 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 243 243 ! ! Potential nitrogen fixation dependant on temperature and iron 244 244 ztemp = ts(ji,jj,jk,jp_tem,Kmm) … … 261 261 ! ---------------------------------------- 262 262 IF( ln_p4z ) THEN 263 DO_3D( 1, 1, 1, 1, 1, jpkm1)263 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 264 264 zfact = nitrpot(ji,jj,jk) * nitrfix 265 265 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 … … 278 278 END_3D 279 279 ELSE ! p5z 280 DO_3D( 1, 1, 1, 1, 1, jpkm1)280 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 281 281 zfact = nitrpot(ji,jj,jk) * nitrfix 282 282 tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zfact / 3.0 -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zsink.F90
r13295 r15122 81 81 ! by data and from the coagulation theory 82 82 ! ----------------------------------------------------------- 83 DO_3D( 1, 1, 1, 1, 1, jpkm1)83 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 84 84 zmax = MAX( heup_01(ji,jj), hmld(ji,jj) ) 85 85 zfact = MAX( 0., gdepw(ji,jj,jk+1,Kmm) - zmax ) / wsbio2scale -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p4zsms.F90
r15023 r15122 130 130 xnegtr(:,:,:) = 1.e0 131 131 DO jn = jp_pcs0, jp_pcs1 132 DO_3D( 1, 1, 1, 1, 1, jpk)132 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk) 133 133 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 134 134 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zlim.F90
r13434 r15122 131 131 zratchl = 6.0 132 132 ! 133 DO_3D( 1, 1, 1, 1, 1, jpkm1)133 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 134 134 ! 135 135 ! Tuning of the iron concentration to a minimum level that is set to the detection limit … … 318 318 ! phytoplankton (see Daines et al., 2013). 319 319 ! -------------------------------------------------------------------------------------------------- 320 DO_3D( 1, 1, 1, 1, 1, jpkm1)320 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 321 321 ! Size estimation of nanophytoplankton 322 322 ! ------------------------------------ … … 367 367 ! Compute the fraction of nanophytoplankton that is made of calcifiers 368 368 ! -------------------------------------------------------------------- 369 DO_3D( 1, 1, 1, 1, 1, jpkm1)369 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 370 370 zlim1 = tr(ji,jj,jk,jpnh4,Kbb) / ( tr(ji,jj,jk,jpnh4,Kbb) + concnnh4 ) + tr(ji,jj,jk,jpno3,Kbb) & 371 371 & / ( tr(ji,jj,jk,jpno3,Kbb) + concnno3 ) * ( 1.0 - tr(ji,jj,jk,jpnh4,Kbb) & … … 385 385 END_3D 386 386 ! 387 DO_3D( 1, 1, 1, 1, 1, jpkm1)387 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 388 388 ! denitrification factor computed from O2 levels 389 389 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - tr(ji,jj,jk,jpoxy,Kbb) ) & -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zmeso.F90
r13295 r15122 98 98 IF ( bmetexc2 ) zmetexcess = 1.0 99 99 100 DO_3D( 1, 1, 1, 1, 1, jpkm1)100 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 101 101 zcompam = MAX( ( tr(ji,jj,jk,jpmes,Kbb) - 1.e-9 ), 0.e0 ) 102 102 zfact = xstep * tgfunc2(ji,jj,jk) * zcompam -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zmicro.F90
r13295 r15122 96 96 IF ( bmetexc ) zmetexcess = 1.0 97 97 ! 98 DO_3D( 1, 1, 1, 1, 1, jpkm1)98 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 99 99 zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 ) 100 100 zfact = xstep * tgfunc2(ji,jj,jk) * zcompaz -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zmort.F90
r13295 r15122 82 82 ! 83 83 prodcal(:,:,:) = 0. !: calcite production variable set to zero 84 DO_3D( 1, 1, 1, 1, 1, jpkm1)84 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 85 85 zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 ) 86 86 ! Squared mortality of Phyto similar to a sedimentation term during … … 148 148 IF( ln_timing ) CALL timing_start('p5z_pico') 149 149 ! 150 DO_3D( 1, 1, 1, 1, 1, jpkm1)150 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 151 151 zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 ) 152 152 ! Squared mortality of Phyto similar to a sedimentation term during … … 207 207 ! 208 208 209 DO_3D( 1, 1, 1, 1, 1, jpkm1)209 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 210 210 211 211 zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. ) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/P4Z/p5zprod.F90
r13295 r15122 125 125 ! day length in hours 126 126 zstrn(:,:) = 0. 127 DO_2D( 1, 1, 1, 1)127 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 128 128 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 129 129 zargu = MAX( -1., MIN( 1., zargu ) ) … … 132 132 133 133 ! Impact of the day duration on phytoplankton growth 134 DO_3D( 1, 1, 1, 1, 1, jpkm1)134 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 135 135 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 136 136 zval = MAX( 1., zstrn(ji,jj) ) … … 152 152 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 153 153 154 DO_3D( 1, 1, 1, 1, 1, jpkm1)154 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 155 155 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 156 156 ! Computation of the P-I slope for nanos and diatoms … … 186 186 END_3D 187 187 188 DO_3D( 1, 1, 1, 1, 1, jpkm1)188 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 189 189 190 190 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN … … 208 208 209 209 ! Sea-ice effect on production 210 DO_3D( 1, 1, 1, 1, 1, jpkm1)210 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 211 211 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 212 212 zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) … … 216 216 217 217 ! Computation of the various production terms of nanophytoplankton 218 DO_3D( 1, 1, 1, 1, 1, jpkm1)218 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 219 219 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 220 220 ! production terms for nanophyto. … … 249 249 250 250 ! Computation of the various production terms of picophytoplankton 251 DO_3D( 1, 1, 1, 1, 1, jpkm1)251 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 252 252 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 253 253 ! production terms for picophyto. … … 282 282 283 283 ! Computation of the various production terms of diatoms 284 DO_3D( 1, 1, 1, 1, 1, jpkm1)284 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 285 285 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 286 286 ! production terms for diatomees … … 316 316 END_3D 317 317 318 DO_3D( 1, 1, 1, 1, 1, jpkm1)318 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 319 319 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 320 320 ! production terms for nanophyto. ( chlorophyll ) … … 347 347 348 348 ! Update the arrays TRA which contain the biological sources and sinks 349 DO_3D( 1, 1, 1, 1, 1, jpkm1)349 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 350 350 zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk) 351 351 zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk) … … 410 410 IF( ln_ligand ) THEN 411 411 zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 412 DO_3D( 1, 1, 1, 1, 1, jpkm1)412 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1) 413 413 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk) 414 414 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/PISCES/trcwri_pisces.F90
r14239 r15122 69 69 zo2min (:,:) = tr(:,:,1,jpoxy,Kmm) * tmask(:,:,1) 70 70 zdepo2min(:,:) = gdepw(:,:,1,Kmm) * tmask(:,:,1) 71 DO_3D( 1, 1, 1, 1, 2, jpkm1 )71 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) 72 72 IF( tmask(ji,jj,jk) == 1 ) then 73 73 IF( tr(ji,jj,jk,jpoxy,Kmm) < zo2min(ji,jj) ) then -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trcatf.F90
r14172 r15122 239 239 ENDIF 240 240 ! 241 DO jn = 1, jptra 242 DO_3D( 1, 1, 1, 1, 1, jpkm1 )241 DO jn = 1, jptra 242 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 243 243 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 244 244 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) … … 313 313 ! 314 314 DO jn = 1, jptra 315 DO_3D( 1, 1, 1, 1, 1, jpkm1 )315 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 316 316 ze3t_b = e3t(ji,jj,jk,Kbb) 317 317 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trcsink.F90
r13295 r15122 74 74 iiter(:,:) = 1 75 75 ELSE 76 DO_2D( 1, 1, 1, 1)76 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 77 77 iiter(ji,jj) = 1 78 78 DO jk = 1, jpkm1 … … 86 86 ENDIF 87 87 88 DO_3D( 1, 1, 1, 1, 1,jpkm1 )88 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 89 89 IF( tmask(ji,jj,jk) == 1.0 ) THEN 90 90 zwsmax = 0.5 * e3t(ji,jj,jk,Kmm) * rday / rsfact … … 146 146 DO jn = 1, 2 147 147 ! first guess of the slopes interior values 148 DO_2D( 1, 1, 1, 1)148 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 149 149 ! 150 150 zstep = rsfact / REAL( kiter(ji,jj), wp ) / 2. … … 186 186 END DO 187 187 188 DO_3D( 1, 1, 1, 1, 1,jpkm1 )188 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 189 189 zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 190 190 ztrb(ji,jj,jk) = ztrb(ji,jj,jk) + 2. * zflx -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trdmxl_trc.F90
r14433 r15122 124 124 isum = 0 ; zvlmsk(:,:) = 0.e0 125 125 126 IF( jpktrd_trc < jpk ) THEN ! description ???127 DO_2D( 1, 1, 1, 1 )126 IF( jpktrd_trc < jpk ) THEN 127 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 128 128 IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 129 129 zvlmsk(ji,jj) = tmask(ji,jj,1) … … 148 148 ! ... Weights for vertical averaging 149 149 wkx_trc(:,:,:) = 0.e0 150 DO_3D( 1, 1, 1, 1, 1, jpktrd_trc ) ! initialize wkx_trc with vertical scale factor in mixed-layer150 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpktrd_trc ) ! description ??? 151 151 IF( jk - nmld_trc(ji,jj) < 0 ) wkx_trc(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 152 152 END_3D … … 259 259 ! 260 260 DO jn = 1, jptra 261 DO_2D( 1, 1, 1, 1 )261 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! description ??? 262 262 ik = nmld_trc(ji,jj) 263 263 IF( ln_trdtrc(jn) ) & -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/TRP/trdmxl_trc_rst.F90
r13286 r15122 12 12 USE iom ! I/O module 13 13 USE trc ! for ctrcnm 14 USE trd mxl_trc_oce ! for lk_trdmxl_trc14 USE trdtrc_oce ! for lk_trdmxl_trc 15 15 16 16 IMPLICIT NONE … … 53 53 clpath = TRIM(cn_trcrst_outdir) 54 54 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 55 IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF ' TRIM(clpath)//TRIM(clname)55 IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF ', TRIM(clpath)//TRIM(clname) 56 56 CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE. ) 57 57 ENDIF -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/trcais.F90
r15004 r15122 170 170 IF( ln_trc_ais(jn) ) THEN 171 171 jl = n_trc_indais(jn) 172 DO_2D( 1, 1, 1, 1)172 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 173 173 zfact = 1. / e3t(ji,jj,1,Kmm) 174 174 ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + fwficb(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) * zfact … … 182 182 IF( ln_trc_ais(jn) ) THEN 183 183 jl = n_trc_indais(jn) 184 DO_2D( 1, 1, 1, 1)184 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 185 185 IF( ln_isfpar_mlt ) THEN 186 186 zcalv = fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj) … … 214 214 IF( ln_trc_ais(jn) ) THEN 215 215 jl = n_trc_indais(jn) 216 DO_2D( 1, 1, 1, 1)216 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 217 217 DO jk = 1, icblev 218 218 zcalv = fwficb(ji,jj) * r1_rho0 … … 229 229 IF( ln_trc_ais(jn) ) THEN 230 230 jl = n_trc_indais(jn) 231 DO_2D( 1, 1, 1, 1)231 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 232 232 IF( ln_isfpar_mlt ) THEN 233 233 zcalv = - fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj) -
NEMO/branches/UKMO/NEMO_r4.2RC_GO8_package/src/TOP/trcopt.F90
r14558 r15122 86 86 ! Attenuation coef. function of Chlorophyll and wavelength (RGB) 87 87 ! -------------------------------------------------------------- 88 DO_3D( 1, 1, 1, 1, 1, jpkm1 )88 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 89 89 ztmp = ( zchl(ji,jj,jk) + rtrn ) * 1.e6 90 90 ztmp = MIN( 10. , MAX( 0.05, ztmp ) ) … … 108 108 ! 109 109 DO jk = 2, nksrp + 1 110 DO_2D( 1, 1, 1, 1)110 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 111 111 ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) ) 112 112 ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) … … 147 147 ! Weighted broadband attenuation coefficient 148 148 ! ------------------------------------------ 149 DO_3D( 1, 1, 1, 1, 1, jpkm1 )149 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 150 150 ztmp = ze1(ji,jj,jk)* ekb(ji,jj,jk) + ze2(ji,jj,jk) * ekg(ji,jj,jk) + ze3(ji,jj,jk) * ekr(ji,jj,jk) 151 151 xeps(ji,jj,jk) = ztmp / e3t(ji,jj,jk,Kmm) / (etot(ji,jj,jk) + rtrn) … … 163 163 heup_01(:,:) = gdepw(:,:,2,Kmm) 164 164 ! 165 DO_3D( 1, 1, 1, 1, 2, nksrp )165 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp ) 166 166 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 167 167 ! Euphotic level (1st T-level strictly below Euphotic layer) … … 214 214 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 215 215 ! 216 DO_3D( 1, 1, 1, 1, 2, nksrp )216 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksrp ) 217 217 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 218 218 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) … … 226 226 we3(:,:) = zqsr(:,:) 227 227 ! 228 DO_3D( 1, 1, 1, 1, 1, nksrp )228 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksrp ) 229 229 ! integrate PAR over current t-level 230 230 pe1(ji,jj,jk) = we1(ji,jj) / (ekb(ji,jj,jk) + rtrn) * (1. - EXP( -ekb(ji,jj,jk) ))
Note: See TracChangeset
for help on using the changeset viewer.