Changeset 4479
- Timestamp:
- 2014-02-04T13:19:11+01:00 (10 years ago)
- Location:
- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4475 r4479 772 772 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 773 773 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 774 USE par_oce, ONLY: jpkf, jpkfm1775 774 USE arpdebugging, ONLY: dump_array 776 775 !! … … 824 823 mbkmax(ji,jj) = MIN(jpk, MAX(mbkt(ji,jj)+1, mbku(ji,jj), mbkv(ji,jj))) 825 824 ! write(*,*) narea, ': SMPDBG: ', ji, jj, mbkt(ji,jj), mbku(ji,jj), mbkv(ji,jj), mbkmax(ji,jj) 826 !!$ IF(mbkmax(ji,jj) /= jpkf)THEN827 !!$ WRITE (*,*) narea,': ARPDBG: mbkmax at ',ji,jj,' in {mpp_init3,zgr_bot_level} = ',mbkmax(ji,jj),jpkf828 !!$ END IF829 825 END DO 830 826 END DO … … 834 830 ! mbkmax computed in mpp_init3 because needed before ANY halo 835 831 ! swaps can be performed 836 jpkf = MAXVAL( mbkmax(:,:) )837 WRITE(*,*) narea,': ARPDBG: shallowest pt and jpkf = ', &838 MINVAL(mbkmax(:,:)), jpkf839 832 ! Play rather fast and loose and just change the value of jpk 840 833 ! here... 841 jpk = jpkf 834 jpk = MAXVAL( mbkmax(:,:) ) 835 WRITE(*,*) narea,': ARPDBG: shallowest pt and new, sub-domain jpk = ', & 836 MINVAL(mbkmax(:,:)), jpk 842 837 jpkm1 = jpk - 1 843 838 ELSE 844 839 WRITE(*,*) narea,': ARPDBG: NOT trimming domain in z' 845 840 mbkmax(:,:) = jpk 846 jpkf = jpk847 841 END IF 848 jpkfm1 = jpkf - 1849 842 850 843 ! -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4436 r4479 105 105 DO jj = 2, jpjm1 106 106 DO ji = 2, jpim1 107 DO jk = 1, jpk fm1107 DO jk = 1, jpkm1 108 108 zcoef = - p2dt / fse3u(ji,jj,jk) 109 109 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk ) … … 119 119 END DO 120 120 #else 121 DO jk = 1, jpk fm1 ! Matrix121 DO jk = 1, jpkm1 ! Matrix 122 122 DO jj = 2, jpjm1 123 123 DO ji = fs_2, fs_jpim1 ! vector opt. … … 160 160 ua(ji,jj,1) = ub(ji,jj,1) + p2dt * ( ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 161 161 & / ( fse3u(ji,jj,1) * rau0 ) ) 162 DO jk = 2, jpk fm1162 DO jk = 2, jpkm1 163 163 zzwibd = zwi(ji,jj,jk) / zwd(ji,jj,jk-1) 164 164 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == … … 169 169 END DO 170 170 !== third recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk == 171 ua(ji,jj,jpk fm1) = ua(ji,jj,jpkfm1) / zwd(ji,jj,jpkfm1)172 DO jk = jpk f-2, 1, -1171 ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 172 DO jk = jpk-2, 1, -1 173 173 ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 174 174 END DO 175 175 ! Normalization to obtain the general momentum trend ua 176 DO jk = 1, jpk fm1176 DO jk = 1, jpkm1 177 177 ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt 178 178 END DO … … 180 180 END DO 181 181 #else 182 DO jk = 2, jpk fm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==182 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 183 183 DO jj = 2, jpjm1 184 184 DO ji = fs_2, fs_jpim1 ! vector opt. … … 194 194 END DO 195 195 END DO 196 DO jk = 2, jpk fm1196 DO jk = 2, jpkm1 197 197 DO jj = 2, jpjm1 198 198 DO ji = fs_2, fs_jpim1 ! vector opt. … … 205 205 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk == 206 206 DO ji = fs_2, fs_jpim1 ! vector opt. 207 ua(ji,jj,jpk fm1) = ua(ji,jj,jpkfm1) / zwd(ji,jj,jpkfm1)208 END DO 209 END DO 210 DO jk = jpk f-2, 1, -1207 ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 208 END DO 209 END DO 210 DO jk = jpk-2, 1, -1 211 211 DO jj = 2, jpjm1 212 212 DO ji = fs_2, fs_jpim1 ! vector opt. … … 216 216 END DO 217 217 ! Normalization to obtain the general momentum trend ua 218 DO jk = 1, jpk fm1218 DO jk = 1, jpkm1 219 219 DO jj = 2, jpjm1 220 220 DO ji = fs_2, fs_jpim1 ! vector opt. … … 237 237 DO jj = 2, jpjm1 238 238 DO ji = 2, jpim1 239 DO jk = 1, jpk fm1 ! Matrix239 DO jk = 1, jpkm1 ! Matrix 240 240 zcoef = -p2dt / fse3v(ji,jj,jk) 241 241 zzwi = zcoef * avmv (ji,jj,jk ) / fse3vw(ji,jj,jk ) … … 251 251 END DO 252 252 #else 253 DO jk = 1, jpk fm1 ! Matrix253 DO jk = 1, jpkm1 ! Matrix 254 254 DO jj = 2, jpjm1 255 255 DO ji = fs_2, fs_jpim1 ! vector opt. … … 292 292 va(ji,jj,1) = vb(ji,jj,1) + p2dt * ( va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 293 293 & / ( fse3v(ji,jj,1) * rau0 ) ) 294 DO jk = 2, jpk fm1294 DO jk = 2, jpkm1 295 295 zzwibd = zwi(ji,jj,jk) / zwd(ji,jj,jk-1) 296 296 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == … … 301 301 END DO 302 302 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk == 303 va(ji,jj,jpk fm1) = va(ji,jj,jpkfm1) / zwd(ji,jj,jpkfm1)304 DO jk = jpk f-2, 1, -1303 va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 304 DO jk = jpk-2, 1, -1 305 305 va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 306 306 END DO 307 307 ! Normalization to obtain the general momentum trend va 308 DO jk = 1, jpk fm1308 DO jk = 1, jpkm1 309 309 va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt 310 310 END DO … … 312 312 END DO 313 313 #else 314 DO jk = 2, jpk fm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) ==314 DO jk = 2, jpkm1 !== First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 (increasing k) == 315 315 DO jj = 2, jpjm1 316 316 DO ji = fs_2, fs_jpim1 ! vector opt. … … 326 326 END DO 327 327 END DO 328 DO jk = 2, jpk fm1328 DO jk = 2, jpkm1 329 329 DO jj = 2, jpjm1 330 330 DO ji = fs_2, fs_jpim1 ! vector opt. … … 337 337 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk == 338 338 DO ji = fs_2, fs_jpim1 ! vector opt. 339 va(ji,jj,jpk fm1) = va(ji,jj,jpkfm1) / zwd(ji,jj,jpkfm1)340 END DO 341 END DO 342 DO jk = jpk f-2, 1, -1339 va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 340 END DO 341 END DO 342 DO jk = jpk-2, 1, -1 343 343 DO jj = 2, jpjm1 344 344 DO ji = fs_2, fs_jpim1 ! vector opt. … … 349 349 350 350 ! Normalization to obtain the general momentum trend va 351 DO jk = 1, jpk fm1351 DO jk = 1, jpkm1 352 352 DO jj = 2, jpjm1 353 353 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/exchmod.F90
r4476 r4479 300 300 USE par_oce, ONLY: wp, jpreci, jprecj, jpim1 301 301 USE dom_oce, ONLY: nlci, nlcj, nldi, nlei, nldj, nlej, & 302 nperio, nbondi, npolj, narea , jpkf302 nperio, nbondi, npolj, narea 303 303 USE mapcomm_mod, ONLY: Iminus, Iplus, NONE, ilbext, iubext, cyclic_bc 304 304 USE mapcomm_mod, ONLY: trimmed, eidx, widx … … 359 359 ! we can limit the length of our z loops to the 360 360 ! no. of levels above the ocean floor. 361 IF(kdim1 == jpkorig)kdim1 = jpk f361 IF(kdim1 == jpkorig)kdim1 = jpk 362 362 ELSEIF ( PRESENT(ib3) ) THEN 363 363 #if defined key_z_first … … 369 369 ! we can limit the length of our z loops to the 370 370 ! no. of levels above the ocean floor. 371 IF(kdim1 == jpk)kdim1 = jpk f371 IF(kdim1 == jpk)kdim1 = jpk 372 372 ELSEIF ( PRESENT(b2) ) THEN 373 373 kdim1 = SIZE(b2,dim=2) -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4458 r4479 172 172 DO jj = 1, jpjm1 !== i- & j-gradient of density ==! 173 173 DO ji = 1, jpim1 174 DO jk = 1, mbkmax(ji,jj) ! jpk f175 #else 176 DO jk = 1, jpk f!== i- & j-gradient of density ==!174 DO jk = 1, mbkmax(ji,jj) ! jpk 175 #else 176 DO jk = 1, jpk !== i- & j-gradient of density ==! 177 177 DO jj = 1, jpjm1 178 178 DO ji = 1, fs_jpim1 ! vector opt. … … 202 202 DO ji = 1, jpi 203 203 zdzr(ji,jj,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 204 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1204 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 205 205 zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp ) & 206 206 & * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp - 0.5_wp * tmask(ji,jj,jk+1) ) … … 210 210 #else 211 211 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 212 DO jk = 2, jpk fm1212 DO jk = 2, jpkm1 213 213 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 214 214 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 … … 231 231 DO jj = 2, jpjm1 !* Slopes at u and v points 232 232 DO ji = 2, jpim1 233 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1234 #else 235 DO jk = 2, jpk fm1 !* Slopes at u and v points233 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 234 #else 235 DO jk = 2, jpkm1 !* Slopes at u and v points 236 236 DO jj = 2, jpjm1 237 237 DO ji = fs_2, fs_jpim1 ! vector opt. … … 275 275 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 276 276 DO ji = 2, jpim1 277 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1278 #else 279 DO jk = 2, jpk fm1277 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 278 #else 279 DO jk = 2, jpkm1 280 280 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 281 281 DO ji = 2, jpim1 … … 297 297 DO jj = 3, jpj-2 ! other rows 298 298 DO ji = 2, jpim1 299 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1299 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 300 300 #else 301 301 DO jj = 3, jpj-2 ! other rows … … 319 319 DO jj = 2, jpjm1 320 320 DO ji = 2, jpim1 321 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1321 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 322 322 #else 323 323 ! !* decrease along coastal boundaries … … 340 340 DO jj = 2, jpjm1 341 341 DO ji = 2, jpim1 342 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1343 #else 344 DO jk = 2, jpk fm1342 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 343 #else 344 DO jk = 2, jpkm1 345 345 DO jj = 2, jpjm1 346 346 DO ji = fs_2, fs_jpim1 ! vector opt. … … 384 384 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 385 385 DO ji = 2, jpim1 386 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1387 #else 388 DO jk = 2, jpk fm1386 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 387 #else 388 DO jk = 2, jpkm1 389 389 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 390 390 DO ji = 2, jpim1 … … 407 407 DO jj = 3, jpj-2 ! other rows 408 408 DO ji = 2, jpim1 409 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1409 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 410 410 #else 411 411 DO jj = 3, jpj-2 ! other rows … … 430 430 DO jj = 2, jpjm1 431 431 DO ji = 2, jpim1 432 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1432 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 433 433 #else 434 434 ! !* decrease along coastal boundaries … … 450 450 ! ! Gibraltar Strait 451 451 ij0 = 50 ; ij1 = 53 452 ii0 = 69 ; ii1 = 71 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp452 ii0 = 69 ; ii1 = 71 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 453 453 ij0 = 51 ; ij1 = 53 454 ii0 = 68 ; ii1 = 71 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp455 ii0 = 69 ; ii1 = 71 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp456 ii0 = 69 ; ii1 = 71 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp454 ii0 = 68 ; ii1 = 71 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 455 ii0 = 69 ; ii1 = 71 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 456 ii0 = 69 ; ii1 = 71 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 457 457 ! 458 458 ! ! Mediterranean Sea 459 459 ij0 = 49 ; ij1 = 56 460 ii0 = 71 ; ii1 = 90 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp460 ii0 = 71 ; ii1 = 90 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 461 461 ij0 = 50 ; ij1 = 56 462 ii0 = 70 ; ii1 = 90 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp463 ii0 = 71 ; ii1 = 90 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp464 ii0 = 71 ; ii1 = 90 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk f) = 0._wp462 ii0 = 70 ; ii1 = 90 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 463 ii0 = 71 ; ii1 = 90 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 464 ii0 = 71 ; ii1 = 90 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , :jpk ) = 0._wp 465 465 ENDIF 466 466 … … 547 547 DO jj = 1, jpjm1 548 548 DO ji = 1, jpim1 549 DO jk = 1, jpk fm1 !== before lateral T & S gradients at T-level jk ==!550 #else 551 DO jk = 1, jpk fm1 !== before lateral T & S gradients at T-level jk ==!549 DO jk = 1, jpkm1 !== before lateral T & S gradients at T-level jk ==! 550 #else 551 DO jk = 1, jpkm1 !== before lateral T & S gradients at T-level jk ==! 552 552 DO jj = 1, jpjm1 553 553 DO ji = 1, fs_jpim1 ! vector opt. … … 581 581 zdkt(ji,jj,1) = 0._wp !== before vertical T & S gradient at w-level ==! 582 582 zdks(ji,jj,1) = 0._wp 583 DO jk = 2, jpk f583 DO jk = 2, jpk 584 584 zdkt(ji,jj,jk) = ( tb(ji,jj,jk-1) - tb(ji,jj,jk) ) * tmask(ji,jj,jk) 585 585 zdks(ji,jj,jk) = ( sb(ji,jj,jk-1) - sb(ji,jj,jk) ) * tmask(ji,jj,jk) … … 590 590 zdkt(:,:,1) = 0._wp !== before vertical T & S gradient at w-level ==! 591 591 zdks(:,:,1) = 0._wp 592 DO jk = 2, jpk f592 DO jk = 2, jpk 593 593 zdkt(:,:,jk) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk) 594 594 zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk) … … 602 602 DO jj = 1, jpjm1 ! NB: not masked due to the minimum value set 603 603 DO ji = 1, jpim1 604 DO jk = 1, jpk fm1 ! done each pair of triad605 #else 606 DO jk = 1, jpk fm1 ! done each pair of triad604 DO jk = 1, jpkm1 ! done each pair of triad 605 #else 606 DO jk = 1, jpkm1 ! done each pair of triad 607 607 DO jj = 1, jpjm1 ! NB: not masked due to the minimum value set 608 608 DO ji = 1, fs_jpim1 ! vector opt. … … 620 620 DO jj = 1, jpj ! NB: not masked due to the minimum value set 621 621 DO ji = 1, jpi 622 DO jk = 1, jpk fm1 ! done each pair of triad623 #else 624 DO jk = 1, jpk fm1 ! done each pair of triad622 DO jk = 1, jpkm1 ! done each pair of triad 623 #else 624 DO jk = 1, jpkm1 ! done each pair of triad 625 625 DO jj = 1, jpj ! NB: not masked due to the minimum value set 626 626 DO ji = 1, jpi ! vector opt. … … 682 682 DO jj = 1, jpjm1 683 683 DO ji = 1, jpim1 684 DO jk = 1, jpk fm1685 #else 686 DO jk = 1, jpk fm1684 DO jk = 1, jpkm1 685 #else 686 DO jk = 1, jpkm1 687 687 DO jj = 1, jpjm1 688 688 DO ji = 1, fs_jpim1 ! vector opt. … … 818 818 DO jj = 1, jpj 819 819 DO ji = 1, jpi 820 DO jk = 1, mbkmax(ji,jj) ! jpk f! =1 inside the mixed layer, =0 otherwise821 #else 822 DO jk = 1, jpk f! =1 inside the mixed layer, =0 otherwise820 DO jk = 1, mbkmax(ji,jj) ! jpk ! =1 inside the mixed layer, =0 otherwise 821 #else 822 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 823 823 # if defined key_vectopt_loop 824 824 DO jj = 1, 1 … … 987 987 DO jk = 1, mbkmax(ji,jj) 988 988 #else 989 DO jk = 1, jpk f989 DO jk = 1, jpk 990 990 DO jj = 2, jpjm1 991 991 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r4452 r4479 157 157 END DO 158 158 #else 159 zwx(:,:,jpk f) = 0.e0 ; zwz(:,:,jpkf) = 0.e0160 zwy(:,:,jpk f) = 0.e0 ; zwi(:,:,jpkf) = 0.e0159 zwx(:,:,jpk) = 0.e0 ; zwz(:,:,jpk) = 0.e0 160 zwy(:,:,jpk) = 0.e0 ; zwi(:,:,jpk) = 0.e0 161 161 #endif 162 162 ! 2. upstream advection with initial mass fluxes & intermediate update … … 167 167 DO jj = 1, jpjm1 168 168 DO ji = 1, jpim1 169 DO jk = 1, mbkmax(ji,jj)-1 ! jpk fm1170 #else 171 DO jk = 1, jpk fm1169 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 170 #else 171 DO jk = 1, jpkm1 172 172 DO jj = 1, jpjm1 173 173 DO ji = 1, fs_jpim1 ! vector opt. … … 195 195 DO jj = 1, jpj 196 196 DO ji = 1, jpi 197 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1198 #else 199 DO jk = 2, jpk fm1197 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 198 #else 199 DO jk = 2, jpkm1 200 200 DO jj = 1, jpj 201 201 DO ji = 1, jpi … … 214 214 DO jj = 2, jpjm1 215 215 DO ji = 2, jpim1 216 DO jk = 1, mbkmax(ji,jj)-1 ! jpk fm1216 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 217 217 z2dtt = p2dt(jk) 218 218 #else 219 DO jk = 1, jpk fm1219 DO jk = 1, jpkm1 220 220 z2dtt = p2dt(jk) 221 221 DO jj = 2, jpjm1 … … 243 243 IF( l_trd ) THEN 244 244 ! store intermediate advective trends 245 ztrdx(:,:,1:jpk f) = zwx(:,:,1:jpkf) ; ztrdy(:,:,1:jpkf) = zwy(:,:,1:jpkf) ; ztrdz(:,:,1:jpkf) = zwz(:,:,1:jpkf)245 ztrdx(:,:,1:jpk) = zwx(:,:,1:jpk) ; ztrdy(:,:,1:jpk) = zwy(:,:,1:jpk) ; ztrdz(:,:,1:jpk) = zwz(:,:,1:jpk) 246 246 END IF 247 247 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 258 258 DO jj = 1, jpjm1 259 259 DO ji = 1, jpim1 260 DO jk = 1, mbkmax(ji,jj)-1 ! jpk fm1261 #else 262 DO jk = 1, jpk fm1260 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 261 #else 262 DO jk = 1, jpkm1 263 263 DO jj = 1, jpjm1 264 264 DO ji = 1, fs_jpim1 ! vector opt. … … 277 277 DO ji = 1, jpi 278 278 zwz(ji,jj,1) = 0.e0 ! Surface value 279 DO jk = 2, mbkmax(ji,jj)-1 ! jpk fm1279 DO jk = 2, mbkmax(ji,jj)-1 ! jpkm1 280 280 #else 281 281 zwz(:,:,1) = 0.e0 ! Surface value 282 282 ! 283 DO jk = 2, jpk fm1 ! Interior value283 DO jk = 2, jpkm1 ! Interior value 284 284 DO jj = 1, jpj 285 285 DO ji = 1, jpi … … 309 309 DO jj = 2, jpjm1 310 310 DO ji = 2, jpim1 311 DO jk = 1, mbkmax(ji,jj)-1 ! jpk fm1312 #else 313 DO jk = 1, jpk fm1311 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 312 #else 313 DO jk = 1, jpkm1 314 314 DO jj = 2, jpjm1 315 315 DO ji = fs_2, fs_jpim1 ! vector opt. … … 419 419 END DO 420 420 #else 421 zbetup(:,:,jpk f) = 0._wp ; zbetdo(:,:,jpkf) = 0._wp421 zbetup(:,:,jpk) = 0._wp ; zbetdo(:,:,jpk) = 0._wp 422 422 #endif 423 423 … … 433 433 DO jj = 2, jpjm1 434 434 DO ji = 2, jpim1 435 DO jk = 1, mbkmax(ji,jj)-1 ! jpk fm1435 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 436 436 ikm1 = MAX(jk-1,1) 437 437 z2dtt = p2dt(jk) 438 438 #else 439 DO jk = 1, jpk fm1439 DO jk = 1, jpkm1 440 440 ikm1 = MAX(jk-1,1) 441 441 z2dtt = p2dt(jk) … … 484 484 DO jj = 2, jpjm1 485 485 DO ji = 2, jpim1 486 DO jk = 1, mbkmax(ji,jj)-1 ! jpk fm1487 #else 488 DO jk = 1, jpk fm1486 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 487 #else 488 DO jk = 1, jpkm1 489 489 DO jj = 2, jpjm1 490 490 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4427 r4479 189 189 #else 190 190 !!bug ajout.... why? ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 191 zdit (1,:,1:jpk f) = 0.e0 ; zdit (jpi,:,1:jpkf) = 0.e0192 zdjt (1,:,1:jpk f) = 0.e0 ; zdjt (jpi,:,1:jpkf) = 0.e0191 zdit (1,:,1:jpk) = 0.e0 ; zdit (jpi,:,1:jpk) = 0.e0 192 zdjt (1,:,1:jpk) = 0.e0 ; zdjt (jpi,:,1:jpk) = 0.e0 193 193 !!end 194 DO jk = 1, jpk fm1 ! jpkm1194 DO jk = 1, jpkm1 ! jpkm1 195 195 DO jj = 1, jpjm1 196 196 DO ji = 1, fs_jpim1 ! vector opt. … … 326 326 !CDIR PARALLEL DO PRIVATE( zdk1t ) 327 327 ! ! =============== 328 DO jk = 1, jpk fm1 ! jpkm1 ! Horizontal slab328 DO jk = 1, jpkm1 ! jpkm1 ! Horizontal slab 329 329 ! ! =============== 330 330 ! 1. Vertical tracer gradient at level jk and jk+1 … … 395 395 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 396 396 #else 397 DO jk = 1, jpk fm1 ! jpkm1397 DO jk = 1, jpkm1 ! jpkm1 398 398 DO jj = 2, jpjm1 399 399 DO ji = fs_2, fs_jpim1 ! vector opt. … … 412 412 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 413 413 #else 414 DO jk = 1, jpk fm1 ! jpkm1414 DO jk = 1, jpkm1 ! jpkm1 415 415 DO jj = 2, jpjm1 416 416 DO ji = fs_2, fs_jpim1 ! vector opt. … … 441 441 ztfw(:,:,:) = 0.0_wp 442 442 #else 443 ztfw(1,:,1:jpk f) = 0.e0 ; ztfw(jpi,:,1:jpkf) = 0.e0444 ztfw(:,:, 1 ) = 0.e0 ; ztfw(:,:,jpk f) = 0.e0443 ztfw(1,:,1:jpk) = 0.e0 ; ztfw(jpi,:,1:jpk) = 0.e0 444 ztfw(:,:, 1 ) = 0.e0 ; ztfw(:,:,jpk) = 0.e0 445 445 #endif 446 446 … … 451 451 DO jk = 2, mbkmax(ji,jj)-1 452 452 #else 453 DO jk = 2, jpk fm1453 DO jk = 2, jpkm1 454 454 DO jj = 2, jpjm1 455 455 DO ji = fs_2, fs_jpim1 ! vector opt. … … 481 481 DO jk = 1, mbkmax(ji,jj)-1 482 482 #else 483 DO jk = 1, jpk fm1483 DO jk = 1, jpkm1 484 484 DO jj = 2, jpjm1 485 485 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4425 r4479 287 287 DO ji = 1, jpi 288 288 zpelc(ji,jj,1) = MAX( rn2b(ji,jj,1), 0._wp ) * fsdepw(ji,jj,1) * fse3w(ji,jj,1) 289 DO jk = 2, jpk f289 DO jk = 2, jpk 290 290 zpelc(ji,jj,jk) = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * fsdepw(ji,jj,jk) * fse3w(ji,jj,jk) 291 291 END DO … … 294 294 #else 295 295 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1) 296 DO jk = 2, jpk f296 DO jk = 2, jpk 297 297 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk) 298 298 END DO … … 305 305 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) 306 306 zus = zcof * taum(ji,jj) 307 DO jk = jpk fm1, 2, -1308 #else 309 DO jk = jpk fm1, 2, -1307 DO jk = jpkm1, 2, -1 308 #else 309 DO jk = jpkm1, 2, -1 310 310 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 311 311 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) … … 332 332 DO ji = 2, jpim1 333 333 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 334 DO jk = 2, jpk fm1335 #else 336 !CDIR NOVERRCHK 337 DO jk = 2, jpk fm1 !* TKE Langmuir circulation source term added to en334 DO jk = 2, jpkm1 335 #else 336 !CDIR NOVERRCHK 337 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 338 338 !CDIR NOVERRCHK 339 339 DO jj = 2, jpjm1 … … 365 365 DO jj = 1, jpj 366 366 DO ji = 1, jpi 367 DO jk = 2, jpk fm1368 #else 369 DO jk = 2, jpk fm1 !* Shear production at uw- and vw-points (energy conserving form)367 DO jk = 2, jpkm1 368 #else 369 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 370 370 DO jj = 1, jpj ! here avmu, avmv used as workspace 371 371 DO ji = 1, jpi … … 387 387 DO jj = 2, jpjm1 388 388 DO ji = 2, jpim1 389 DO jk = 2, jpk fm1 !* Matrix and right hand side in en390 #else 391 DO jk = 2, jpk fm1 !* Matrix and right hand side in en389 DO jk = 2, jpkm1 !* Matrix and right hand side in en 390 #else 391 DO jk = 2, jpkm1 !* Matrix and right hand side in en 392 392 DO jj = 2, jpjm1 393 393 DO ji = fs_2, fs_jpim1 ! vector opt. … … 417 417 DO ji = 2, jpim1 418 418 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 419 DO jk = 3, jpk fm1419 DO jk = 3, jpkm1 420 420 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 421 421 END DO 422 422 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 423 423 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 424 DO jk = 3, jpk fm1424 DO jk = 3, jpkm1 425 425 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 426 426 END DO 427 427 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 428 en(ji,jj,jpk fm1) = zd_lw(ji,jj,jpkfm1) / zdiag(ji,jj,jpkfm1)429 DO jk = jpk f-2, 2, -1428 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 429 DO jk = jpk-2, 2, -1 430 430 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 431 431 END DO 432 DO jk = 2, jpk fm1 ! set the minimum value of tke432 DO jk = 2, jpkm1 ! set the minimum value of tke 433 433 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk) 434 434 END DO … … 436 436 END DO 437 437 #else 438 DO jk = 3, jpk fm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1438 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 439 439 DO jj = 2, jpjm1 440 440 DO ji = fs_2, fs_jpim1 ! vector opt. … … 448 448 END DO 449 449 END DO 450 DO jk = 3, jpk fm1450 DO jk = 3, jpkm1 451 451 DO jj = 2, jpjm1 452 452 DO ji = fs_2, fs_jpim1 ! vector opt. … … 457 457 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 458 458 DO ji = fs_2, fs_jpim1 ! vector opt. 459 en(ji,jj,jpk fm1) = zd_lw(ji,jj,jpkfm1) / zdiag(ji,jj,jpkfm1)460 END DO 461 END DO 462 DO jk = jpk f-2, 2, -1459 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 460 END DO 461 END DO 462 DO jk = jpk-2, 2, -1 463 463 DO jj = 2, jpjm1 464 464 DO ji = fs_2, fs_jpim1 ! vector opt. … … 467 467 END DO 468 468 END DO 469 DO jk = 2, jpk fm1 ! set the minimum value of tke469 DO jk = 2, jpkm1 ! set the minimum value of tke 470 470 DO jj = 2, jpjm1 471 471 DO ji = fs_2, fs_jpim1 ! vector opt. … … 483 483 DO jj = 2, jpjm1 484 484 DO ji = 2, jpim1 485 DO jk = 2, jpk fm1486 #else 487 DO jk = 2, jpk fm1485 DO jk = 2, jpkm1 486 #else 487 DO jk = 2, jpkm1 488 488 DO jj = 2, jpjm1 489 489 DO ji = fs_2, fs_jpim1 ! vector opt. … … 507 507 !! unless we also make zdif a 2-d (jpi,jpj) array 508 508 !CDIR NOVERRCHK 509 DO jk = 2, jpk fm1509 DO jk = 2, jpkm1 510 510 !CDIR NOVERRCHK 511 511 DO jj = 2, jpjm1 … … 601 601 DO jj = 2, jpjm1 602 602 DO ji = 2, jpim1 603 zmxlm(ji,jj,jpk f) = rmxl_min ! last level set to the interior minium value604 DO jk = 2, jpk fm1 ! interior value : l=sqrt(2*e/n^2)605 #else 606 zmxlm(:,:,jpk f) = rmxl_min ! last level set to the interior minium value607 ! 608 !CDIR NOVERRCHK 609 DO jk = 2, jpk fm1 ! interior value : l=sqrt(2*e/n^2)603 zmxlm(ji,jj,jpk) = rmxl_min ! last level set to the interior minium value 604 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 605 #else 606 zmxlm(:,:,jpk) = rmxl_min ! last level set to the interior minium value 607 ! 608 !CDIR NOVERRCHK 609 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 610 610 !CDIR NOVERRCHK 611 611 DO jj = 2, jpjm1 … … 622 622 ! 623 623 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the zmxlm value 624 zmxld(:,:,jpk f) = rmxl_min ! last level set to the minimum value624 zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value 625 625 ! 626 626 SELECT CASE ( nn_mxl ) … … 630 630 DO jj = 2, jpjm1 631 631 DO ji = 2, jpim1 632 DO jk = 2, jpk fm1633 #else 634 DO jk = 2, jpk fm1632 DO jk = 2, jpkm1 633 #else 634 DO jk = 2, jpkm1 635 635 DO jj = 2, jpjm1 636 636 DO ji = fs_2, fs_jpim1 ! vector opt. … … 648 648 DO jj = 2, jpjm1 649 649 DO ji = 2, jpim1 650 DO jk = 2, jpk fm1651 #else 652 DO jk = 2, jpk fm1650 DO jk = 2, jpkm1 651 #else 652 DO jk = 2, jpkm1 653 653 DO jj = 2, jpjm1 654 654 DO ji = fs_2, fs_jpim1 ! vector opt. … … 665 665 DO jj = 2, jpjm1 666 666 DO ji = 2, jpim1 667 DO jk = 2, jpk fm1 ! from the surface to the bottom :667 DO jk = 2, jpkm1 ! from the surface to the bottom : 668 668 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 669 669 END DO 670 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface :670 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 671 671 zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 672 672 zmxlm(ji,jj,jk) = zemxl … … 676 676 END DO 677 677 #else 678 DO jk = 2, jpk fm1 ! from the surface to the bottom :678 DO jk = 2, jpkm1 ! from the surface to the bottom : 679 679 DO jj = 2, jpjm1 680 680 DO ji = fs_2, fs_jpim1 ! vector opt. … … 683 683 END DO 684 684 END DO 685 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface :685 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 686 686 DO jj = 2, jpjm1 687 687 DO ji = fs_2, fs_jpim1 ! vector opt. … … 698 698 DO jj = 2, jpjm1 699 699 DO ji = 2, jpim1 700 DO jk = 2, jpk fm1 ! from the surface to the bottom : lup700 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 701 701 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 702 702 END DO 703 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface : ldown703 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 704 704 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 705 705 END DO 706 DO jk = 2, jpk fm1706 DO jk = 2, jpkm1 707 707 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 708 708 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) … … 713 713 END DO 714 714 #else 715 DO jk = 2, jpk fm1 ! from the surface to the bottom : lup715 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 716 716 DO jj = 2, jpjm1 717 717 DO ji = fs_2, fs_jpim1 ! vector opt. … … 720 720 END DO 721 721 END DO 722 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface : ldown722 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 723 723 DO jj = 2, jpjm1 724 724 DO ji = fs_2, fs_jpim1 ! vector opt. … … 728 728 END DO 729 729 !CDIR NOVERRCHK 730 DO jk = 2, jpk fm1730 DO jk = 2, jpkm1 731 731 !CDIR NOVERRCHK 732 732 DO jj = 2, jpjm1 … … 755 755 DO jj = 2, jpjm1 756 756 DO ji = 2, jpim1 757 DO jk = 1, jpk fm1 !* vertical eddy viscosity & diffivity at w-points758 #else 759 !CDIR NOVERRCHK 760 DO jk = 1, jpk fm1 !* vertical eddy viscosity & diffivity at w-points757 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 758 #else 759 !CDIR NOVERRCHK 760 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 761 761 !CDIR NOVERRCHK 762 762 DO jj = 2, jpjm1 … … 777 777 DO jj = 2, jpjm1 778 778 DO ji = 2, jpim1 779 DO jk = 2, jpk fm1 !* vertical eddy viscosity at u- and v-points780 #else 781 DO jk = 2, jpk fm1 !* vertical eddy viscosity at u- and v-points779 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 780 #else 781 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 782 782 DO jj = 2, jpjm1 783 783 DO ji = fs_2, fs_jpim1 ! vector opt. … … 795 795 DO jj = 2, jpjm1 796 796 DO ji = 2, jpim1 797 DO jk = 2, jpk fm1798 #else 799 DO jk = 2, jpk fm1797 DO jk = 2, jpkm1 798 #else 799 DO jk = 2, jpkm1 800 800 DO jj = 2, jpjm1 801 801 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4423 r4479 242 242 jpkm1 = jpk-1 ! inner domain indices 243 243 jpkorig = jpk ! Copy of jpk that is NOT modified 244 jpkf = jpk ! Max depth of this sub-domain. Initially set to jpk here245 ! but altered later in domzgr246 244 ENDIF 247 245 -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r4421 r4479 177 177 INTEGER, PUBLIC :: jpj ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dimension 178 178 INTEGER, PUBLIC :: jpk ! = jpkdta !: third dimension 179 INTEGER, PUBLIC :: jpkf ! <= jpk !: Max wet level of MPP subdomain 180 INTEGER, PUBLIC :: jpkorig ! = jpk before it is reset to jpkf 179 INTEGER, PUBLIC :: jpkorig ! = jpk before it is reduced to a sub-domain-local value 181 180 INTEGER, PUBLIC :: jpim1 ! = jpi-1 !: inner domain indices 182 181 INTEGER, PUBLIC :: jpjm1 ! = jpj-1 !: - - - 183 182 INTEGER, PUBLIC :: jpkm1 ! = jpk-1 !: - - - 184 INTEGER, PUBLIC :: jpkfm1 ! = jpkf-1 !: - - -185 183 INTEGER, PUBLIC :: jpij ! = jpi*jpj !: jpi x jpj 186 184
Note: See TracChangeset
for help on using the changeset viewer.