- Timestamp:
- 2012-07-11T13:22:58+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r3211 r3432 98 98 !! ** Action : Update pta arrays with the before rotated diffusion 99 99 !!---------------------------------------------------------------------- 100 USE timing, ONLY: timing_start, timing_stop 100 101 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 101 102 USE oce , ONLY: zftu => ua , zftv => va ! (ua,va) used as workspace … … 103 104 !FTRANS zftu zftv :I :I :z 104 105 #if defined key_z_first 105 USE wrk_nemo, ONLY: wdkt => wrk_3d_9 , wdk1t => wrk_3d_10 ! 3D workspace106 ! USE wrk_nemo, ONLY: wdkt => wrk_3d_9 , wdk1t => wrk_3d_10 ! 3D workspace 106 107 !FTRANS wdkt wdk1t :I :I :z 107 108 #else … … 131 132 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 132 133 REAL(wp) :: zcoef0, zbtr, ztra ! - - 134 #if defined key_z_first 135 REAL(wp) :: wdkt , wdki1t , wdkim1t , wdkj1t , wdkjm1t 136 REAL(wp) :: wdk1t, wdk1i1t, wdk1im1t, wdk1j1t, wdk1jm1t 137 #endif 138 133 139 #if defined key_diaar5 134 140 REAL(wp) :: zztmp ! local scalar 135 141 #endif 136 142 !!---------------------------------------------------------------------- 143 144 CALL timing_start('tra_ldf_iso') 137 145 138 146 #if defined key_z_first … … 151 159 ! 152 160 ! ! =========== 161 !DIR$ SHORTLOOP 153 162 DO jn = 1, kjpt ! tracer loop 154 163 ! ! =========== … … 157 166 !! I - masked horizontal derivative 158 167 !!---------------------------------------------------------------------- 168 CALL timing_start('traldf_iso_I') 159 169 !!bug ajout.... why? ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 170 #if defined key_z_first 171 DO jj=1,jpj,1 172 DO jk=1,jpk,1 173 zdit(1 ,jj,jk) = 0.0_wp 174 zdit(jpi,jj,jk) = 0.0_wp 175 zdjt(1 ,jj,jk) = 0.0_wp 176 zdjt(jpi,jj,jk) = 0.0_wp 177 END DO 178 END DO 179 #else 160 180 zdit (1,:,:) = 0.e0 ; zdit (jpi,:,:) = 0.e0 161 181 zdjt (1,:,:) = 0.e0 ; zdjt (jpi,:,:) = 0.e0 182 #endif 162 183 !!end 163 184 … … 185 206 END DO 186 207 ENDIF 208 ! 209 CALL timing_stop('traldf_iso_I','section') 187 210 188 211 !!---------------------------------------------------------------------- 189 212 !! II - horizontal trend (full) 190 213 !!---------------------------------------------------------------------- 214 CALL timing_start('traldf_iso_II') 191 215 #if defined key_z_first 192 216 ! 1. Vertical tracer gradient at level jk and jk+1 … … 194 218 ! surface boundary condition: wdkt(jk=1)=wdkt(jk=2) 195 219 196 DO jj = 1, jpj197 DO ji = 1, jpi198 DO jk = 1, jpkm1199 wdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1)200 END DO201 wdkt(ji,jj,1) = wdk1t(ji,jj,1)202 DO jk = 2, jpkm1203 wdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk)204 END DO205 END DO206 END DO220 !!$ DO jj = 1, jpj 221 !!$ DO ji = 1, jpi 222 !!$ DO jk = 1, jpkm1 223 !!$ wdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 224 !!$ END DO 225 !!$ wdkt(ji,jj,1) = wdk1t(ji,jj,1) 226 !!$ DO jk = 2, jpkm1 227 !!$ wdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 228 !!$ END DO 229 !!$ END DO 230 !!$ END DO 207 231 208 232 ! 2. Horizontal fluxes 209 233 ! -------------------- 210 DO jj = 1 , jpjm1 211 DO ji = 1, jpim1 212 DO jk = 1, jpkm1 213 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 214 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 215 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & 216 & + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk ), 1. ) 217 zmskv = 1. / MAX( tmask(ji,jj+1,jk ) + tmask(ji,jj,jk+1) & 218 & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. ) 219 zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 220 zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 221 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 222 & + zcof1 * ( wdkt (ji+1,jj,jk) + wdk1t(ji,jj,jk) & 223 & + wdk1t(ji+1,jj,jk) + wdkt (ji,jj,jk) ) ) * umask(ji,jj,jk) 224 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 225 & + zcof2 * ( wdkt (ji,jj+1,jk) + wdk1t(ji,jj,jk) & 226 & + wdk1t(ji,jj+1,jk) + wdkt (ji,jj,jk) ) ) * vmask(ji,jj,jk) 227 END DO 228 END DO 229 END DO 230 231 ! II.4 Second derivative (divergence) and add to the general trend 232 ! ---------------------------------------------------------------- 234 !!$ DO jj = 1 , jpjm1 235 !!$ DO ji = 1, jpim1 236 !!$ DO jk = 1, jpkm1 237 !!$ zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 238 !!$ zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 239 !!$ zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & 240 !!$ & + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk ), 1. ) 241 !!$ zmskv = 1. / MAX( tmask(ji,jj+1,jk ) + tmask(ji,jj,jk+1) & 242 !!$ & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. ) 243 !!$ zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 244 !!$ zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 245 !!$ zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 246 !!$ & + zcof1 * ( wdkt (ji+1,jj,jk) + wdk1t(ji,jj,jk) & 247 !!$ & + wdk1t(ji+1,jj,jk) + wdkt (ji,jj,jk) ) ) * umask(ji,jj,jk) 248 !!$ zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 249 !!$ & + zcof2 * ( wdkt (ji,jj+1,jk) + wdk1t(ji,jj,jk) & 250 !!$ & + wdk1t(ji,jj+1,jk) + wdkt (ji,jj,jk) ) ) * vmask(ji,jj,jk) 251 !!$ END DO 252 !!$ END DO 253 !!$ END DO 254 233 255 DO jj = 2 , jpjm1 234 256 DO ji = 2, jpim1 235 257 DO jk = 1, jpkm1 236 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 237 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 258 259 ! 1. Vertical tracer gradient at level jk and jk+1 260 ! ------------------------------------------------ 261 ! surface boundary condition: wdkt(jk=1)=wdkt(jk=2) 262 263 wdk1t = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 264 wdk1i1t = ( ptb(ji+1,jj,jk,jn) - ptb(ji+1,jj,jk+1,jn) ) * tmask(ji+1,jj,jk+1) 265 wdk1im1t = ( ptb(ji-1,jj,jk,jn) - ptb(ji-1,jj,jk+1,jn) ) * tmask(ji-1,jj,jk+1) 266 wdk1j1t = ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj+1,jk+1,jn) ) * tmask(ji,jj+1,jk+1) 267 wdk1jm1t = ( ptb(ji,jj-1,jk,jn) - ptb(ji,jj-1,jk+1,jn) ) * tmask(ji,jj-1,jk+1) 268 269 IF(jk > 1)THEN 270 wdkt = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 271 wdki1t = ( ptb(ji+1,jj,jk-1,jn) - ptb(ji+1,jj,jk,jn) ) * tmask(ji+1,jj,jk) 272 wdkim1t = ( ptb(ji-1,jj,jk-1,jn) - ptb(ji-1,jj,jk,jn) ) * tmask(ji-1,jj,jk) 273 wdkj1t = ( ptb(ji,jj+1,jk-1,jn) - ptb(ji,jj+1,jk,jn) ) * tmask(ji,jj+1,jk) 274 wdkjm1t = ( ptb(ji,jj-1,jk-1,jn) - ptb(ji,jj-1,jk,jn) ) * tmask(ji,jj-1,jk) 275 ELSE 276 wdkt = wdk1t 277 wdki1t = wdk1i1t 278 wdkim1t= wdk1im1t 279 wdkj1t = wdk1j1t 280 wdkjm1t= wdk1jm1t 281 END IF 282 283 ! II.4 Second derivative (divergence) and add to the general trend 284 ! ---------------------------------------------------------------- 285 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 286 287 ztra = zbtr * ( & 288 289 ! zftu(ji,jj,jk) - 290 ( ((fsahtu(ji,jj,jk) + pahtb0) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)) * zdit(ji,jj,jk) & 291 - ( fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) / & 292 MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & 293 + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk ), 1.) ) * & 294 (wdki1t + wdk1t + wdk1i1t + wdkt) ) * umask(ji,jj,jk) - & 295 296 ! zftu(ji-1,jj,jk) + 297 ( ((fsahtu(ji-1,jj,jk) + pahtb0) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) / e1u(ji-1,jj)) * zdit(ji-1,jj,jk) & 298 - ( fsahtu(ji-1,jj,jk) * e2u(ji-1,jj) * uslp(ji-1,jj,jk) / & 299 MAX( tmask(ji,jj,jk ) + tmask(ji-1,jj,jk+1) & 300 + tmask(ji,jj,jk+1) + tmask(ji-1,jj,jk ), 1.) ) * & 301 (wdkt + wdk1im1t + wdk1t + wdkim1t) ) * umask(ji-1,jj,jk) + & 302 303 304 ! zftv(ji,jj,jk) - 305 ( ((fsahtv(ji,jj,jk) + pahtb0) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)) * zdjt(ji,jj,jk) & 306 & - ( fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) / & 307 MAX( tmask(ji,jj+1,jk ) + tmask(ji,jj,jk+1) & 308 & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. )) * & 309 (wdkj1t + wdk1t + wdk1j1t + wdkt) ) * vmask(ji,jj,jk) - & 310 ! zftv(ji,jj-1,jk) & 311 ( ((fsahtv(ji,jj-1,jk) + pahtb0) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) / e2v(ji,jj-1)) * zdjt(ji,jj-1,jk) & 312 & - ( fsahtv(ji,jj-1,jk) * e1v(ji,jj-1) * vslp(ji,jj-1,jk) / & 313 MAX( tmask(ji,jj,jk ) + tmask(ji,jj-1,jk+1) & 314 & + tmask(ji,jj,jk+1) + tmask(ji,jj-1,jk ), 1. )) * & 315 (wdkt + wdk1jm1t + wdk1t + wdkjm1t) ) * vmask(ji,jj-1,jk) & 316 317 ) 238 318 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 239 319 END DO … … 295 375 ! "Poleward" diffusive heat or salt transports (T-S case only) 296 376 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 297 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 298 IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) ) 377 IF( jn == jp_tem)THEN 378 htr_ldf = ptr_vj( zftv ) 379 END IF 380 IF( jn == jp_sal)THEN 381 str_ldf = ptr_vj( zftv ) 382 END IF 299 383 ENDIF 300 384 … … 338 422 END IF 339 423 #endif 424 CALL timing_stop('traldf_iso_II','section') 340 425 341 426 !!---------------------------------------------------------------------- 342 427 !! III - vertical trend of T & S (extra diagonal terms only) 343 428 !!---------------------------------------------------------------------- 429 CALL timing_start('traldf_iso_III') 344 430 345 431 ! Local constant initialization 346 432 ! ----------------------------- 433 #if defined key_z_first 434 DO jj=1,jpj,1 435 DO jk=1,jpk,1 436 ztfw(1 ,jj,jk) = 0.0_wp 437 ztfw(jpi,jj,jk) = 0.0_wp 438 END DO 439 END DO 440 #else 347 441 ztfw(1,:,:) = 0.e0 ; ztfw(jpi,:,:) = 0.e0 348 442 #endif 349 443 ! Vertical fluxes 350 444 ! --------------- 351 445 352 446 ! Surface and bottom vertical fluxes set to zero 447 #if defined key_z_first 448 DO ji=1,jpi,1 449 DO jj=1,jpj,1 450 ztfw(ji,jj,1 ) = 0.0_wp 451 ztfw(ji,jj,jpk) = 0.0_wp 452 END DO 453 END DO 454 #else 353 455 ztfw(:,:, 1 ) = 0.e0 ; ztfw(:,:,jpk) = 0.e0 354 456 #endif 457 355 458 ! interior (2=<jk=<jpk-1) 356 459 #if defined key_z_first … … 400 503 END DO 401 504 ! 505 506 CALL timing_stop('traldf_iso_III','section') 507 402 508 END DO 403 509 ! … … 409 515 wrk_not_released(2, 1,2,3) ) CALL ctl_stop('tra_ldf_iso: failed to release workspace arrays') 410 516 #endif 517 ! 518 CALL timing_stop('tra_ldf_iso','section') 411 519 ! 412 520 END SUBROUTINE tra_ldf_iso
Note: See TracChangeset
for help on using the changeset viewer.