Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r7646 r7698 72 72 INTEGER, DIMENSION(:,:), INTENT(out) :: k_top, k_bot ! ocean first and last level indices 73 73 ! 74 INTEGER :: j k ! dummy loop index74 INTEGER :: ji, jj, jk ! dummy loop index 75 75 INTEGER :: ioptio, ibat, ios ! local integer 76 76 REAL(wp) :: zrefdep ! depth of the reference level (~10m) … … 114 114 !!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears 115 115 ! Compute gde3w_0 (vertical sum of e3w) 116 gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 116 !$OMP PARALLEL 117 !$OMP DO schedule(static) private(jj, ji) 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 121 END DO 122 END DO 117 123 DO jk = 2, jpk 118 gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 119 END DO 124 !$OMP DO schedule(static) private(jj, ji) 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 128 END DO 129 END DO 130 END DO 131 !$OMP END PARALLEL 120 132 ! 121 133 IF(lwp) THEN ! Control print … … 190 202 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top , k_bot ! first & last ocean level 191 203 ! 192 INTEGER :: jk 204 INTEGER :: jk, jj, ji ! dummy loop index 193 205 INTEGER :: inum ! local logical unit 194 206 REAL(WP) :: z_zco, z_zps, z_sco, z_cav … … 254 266 ! !* ocean top and bottom level 255 267 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! 1st wet T-points (ISF) 256 k_top(:,:) = INT( z2d(:,:) ) 268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 k_top(ji,jj) = INT( z2d(ji,jj) ) 272 END DO 273 END DO 257 274 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! last wet T-points 258 k_bot(:,:) = INT( z2d(:,:) ) 275 !$OMP PARALLEL DO schedule(static) private(jj, ji) 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 k_bot(ji,jj) = INT( z2d(ji,jj) ) 279 END DO 280 END DO 259 281 ! 260 282 ! bathymetry with orography (wetting and drying only) … … 295 317 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 296 318 ! 297 mikt(:,:) = MAX( k_top(:,:) , 1 ) ! top ocean k-index of T-level (=1 over land) 298 ! 299 mbkt(:,:) = MAX( k_bot(:,:) , 1 ) ! bottom ocean k-index of T-level (=1 over land) 300 319 !$OMP PARALLEL 320 !$OMP DO schedule(static) private(jj, ji) 321 DO jj = 1, jpj 322 DO ji = 1, jpi 323 mikt(ji,jj) = MAX( k_top(ji,jj) , 1 ) ! top ocean k-index of T-level (=1 over land) 324 ! 325 mbkt(ji,jj) = MAX( k_bot(ji,jj) , 1 ) ! bottom ocean k-index of T-level (=1 over land) 326 END DO 327 END DO 301 328 ! ! N.B. top k-index of W-level = mikt 302 329 ! ! bottom k-index of W-level = mbkt+1 330 !$OMP DO schedule(static) private(jj, ji) 303 331 DO jj = 1, jpjm1 304 332 DO ji = 1, jpim1 … … 312 340 END DO 313 341 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 314 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( INT( zk(:,:) ), 1 ) 315 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( INT( zk(:,:) ), 1 ) 316 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( INT( zk(:,:) ), 1 ) 317 ! 318 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( INT( zk(:,:) ), 1 ) 319 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 342 !$OMP DO schedule(static) private(jj, ji) 343 DO jj = 1, jpj 344 DO ji = 1, jpi 345 zk(ji,jj) = REAL( miku(ji,jj), wp ) 346 END DO 347 END DO 348 !$OMP END PARALLEL 349 CALL lbc_lnk( zk, 'U', 1. ) 350 !$OMP PARALLEL 351 !$OMP DO schedule(static) private(jj, ji) 352 DO jj = 1, jpj 353 DO ji = 1, jpi 354 miku(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 355 END DO 356 END DO 357 !$OMP DO schedule(static) private(jj, ji) 358 DO jj = 1, jpj 359 DO ji = 1, jpi 360 zk(ji,jj) = REAL( mikv(ji,jj), wp ) 361 END DO 362 END DO 363 !$OMP END PARALLEL 364 CALL lbc_lnk( zk, 'V', 1. ) 365 !$OMP PARALLEL 366 !$OMP DO schedule(static) private(jj, ji) 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 mikv(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 370 END DO 371 END DO 372 !$OMP DO schedule(static) private(jj, ji) 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 zk(ji,jj) = REAL( mikf(ji,jj), wp ) 376 END DO 377 END DO 378 !$OMP END PARALLEL 379 CALL lbc_lnk( zk, 'F', 1. ) 380 !$OMP PARALLEL 381 !$OMP DO schedule(static) private(jj, ji) 382 DO jj = 1, jpj 383 DO ji = 1, jpi 384 mikf(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 385 END DO 386 END DO 387 ! 388 !$OMP DO schedule(static) private(jj, ji) 389 DO jj = 1, jpj 390 DO ji = 1, jpi 391 zk(ji,jj) = REAL( mbku(ji,jj), wp ) 392 END DO 393 END DO 394 !$OMP END PARALLEL 395 CALL lbc_lnk( zk, 'U', 1. ) 396 !$OMP PARALLEL 397 !$OMP DO schedule(static) private(jj, ji) 398 DO jj = 1, jpj 399 DO ji = 1, jpi 400 mbku(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 401 END DO 402 END DO 403 !$OMP DO schedule(static) private(jj, ji) 404 DO jj = 1, jpj 405 DO ji = 1, jpi 406 zk(ji,jj) = REAL( mbkv(ji,jj), wp ) 407 END DO 408 END DO 409 !$OMP END PARALLEL 410 CALL lbc_lnk( zk, 'V', 1. ) 411 !$OMP PARALLEL DO schedule(static) private(jj, ji) 412 DO jj = 1, jpj 413 DO ji = 1, jpi 414 mbkv(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 415 END DO 416 END DO 320 417 ! 321 418 CALL wrk_dealloc( jpi,jpj, zk )
Note: See TracChangeset
for help on using the changeset viewer.
