Changeset 2460
- Timestamp:
- 2010-12-07T17:22:05+01:00 (13 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
-
DOM/dommsk.F90 (modified) (25 diffs)
-
DOM/domzgr.F90 (modified) (1 diff)
-
DYN/dynbfr.F90 (modified) (5 diffs)
-
DYN/dynspg_ts.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2392 r2460 55 55 !! zontal velocity points (u & v), vorticity points (f) and baro- 56 56 !! tropic stream function points (b). 57 !! Set mbathy to the number of non-zero w-levels of a water column58 57 !! 59 58 !! ** Method : The ocean/land mask is computed from the basin bathy- … … 72 71 !! or mbathy(ji+1,jj) or mbathy(ji+1,jj+1) =< 0 73 72 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 74 !! and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.73 !! and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 75 74 !! b-point : the same definition as for f-point of the first ocean 76 75 !! level (surface level) but with 0 along coastlines. 76 !! tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 77 !! rows/lines due to cyclic or North Fold boundaries as well 78 !! as MPP halos. 77 79 !! 78 80 !! The lateral friction is set through the value of fmask along … … 98 100 !! - bmask is set to 0 on the open boundaries. 99 101 !! 100 !! Set mbathy to the number of non-zero w-levels of a water column101 !! mbathy = min( mbathy, 1 ) + 1102 !! (note that the minimum value of mbathy is 2).103 !!104 102 !! ** Action : tmask : land/ocean mask at t-point (=0. or 1.) 105 103 !! umask : land/ocean mask at u-point (=0. or 1.) … … 109 107 !! bmask : land/ocean mask at barotropic stream 110 108 !! function point (=0. or 1.) and set to 0 along lateral boundaries 111 !! mbathy : number of non-zero w-levels109 !! tmask_i : interior ocean mask 112 110 !!---------------------------------------------------------------------- 113 111 INTEGER :: ji, jj, jk ! dummy loop indices … … 144 142 ! N.B. tmask has already the right boundary conditions since mbathy is ok 145 143 ! 146 tmask(:,:,:) = 0. e0144 tmask(:,:,:) = 0._wp 147 145 DO jk = 1, jpk 148 146 DO jj = 1, jpj 149 147 DO ji = 1, jpi 150 IF( REAL( mbathy(ji,jj) - jk ) +.1 >= 0.e0 ) tmask(ji,jj,jk) = 1.e0148 IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp ) tmask(ji,jj,jk) = 1._wp 151 149 END DO 152 150 END DO … … 159 157 ij0 = 87 ; ij1 = 88 160 158 ii0 = 160 ; ii1 = 161 161 tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0. e0159 tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp 162 160 ELSE 163 161 IF(lwp) WRITE(numout,*) … … 181 179 ijl = nlcj - jprecj + 1 182 180 183 tmask_i( 1 :iif, : ) = 0. e0! first columns184 tmask_i(iil:jpi, : ) = 0. e0! last columns (including mpp extra columns)185 tmask_i( : , 1 :ijf) = 0. e0! first rows186 tmask_i( : ,ijl:jpj) = 0. e0! last rows (including mpp extra rows)181 tmask_i( 1 :iif, : ) = 0._wp ! first columns 182 tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 183 tmask_i( : , 1 :ijf) = 0._wp ! first rows 184 tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 187 185 188 186 ! north fold mask 189 187 ! --------------- 190 tpol(1:jpiglo) = 1. e0191 fpol(1:jpiglo) = 1. e0188 tpol(1:jpiglo) = 1._wp 189 fpol(1:jpiglo) = 1._wp 192 190 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot 193 tpol(jpiglo/2+1:jpiglo) = 0. e0194 fpol( 1 :jpiglo) = 0. e0191 tpol(jpiglo/2+1:jpiglo) = 0._wp 192 fpol( 1 :jpiglo) = 0._wp 195 193 IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row 196 194 DO ji = iif+1, iil-1 … … 200 198 ENDIF 201 199 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 202 tpol( 1 :jpiglo) = 0. e0203 fpol(jpiglo/2+1:jpiglo) = 0. e0200 tpol( 1 :jpiglo) = 0._wp 201 fpol(jpiglo/2+1:jpiglo) = 0._wp 204 202 ENDIF 205 203 … … 218 216 END DO 219 217 END DO 220 CALL lbc_lnk( umask, 'U', 1. ) ! Lateral boundary conditions221 CALL lbc_lnk( vmask, 'V', 1. )222 CALL lbc_lnk( fmask, 'F', 1. )218 CALL lbc_lnk( umask, 'U', 1._wp ) ! Lateral boundary conditions 219 CALL lbc_lnk( vmask, 'V', 1._wp ) 220 CALL lbc_lnk( fmask, 'F', 1._wp ) 223 221 224 222 … … 230 228 ! ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi 231 229 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 232 bmask( 1 ,:) = 0. e0233 bmask(jpi,:) = 0. e0230 bmask( 1 ,:) = 0._wp 231 bmask(jpi,:) = 0._wp 234 232 ENDIF 235 233 IF( nperio == 2 ) THEN ! south symmetric : bmask must be set to 0. on row 1 236 bmask(:, 1 ) = 0. e0234 bmask(:, 1 ) = 0._wp 237 235 ENDIF 238 236 ! ! north fold : … … 241 239 ii = ji + nimpp - 1 242 240 bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii) 243 bmask(ji,jpj ) = 0. e0241 bmask(ji,jpj ) = 0._wp 244 242 END DO 245 243 ENDIF 246 244 IF( nperio == 5 .OR. nperio == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 247 bmask(:,jpj) = 0. e0245 bmask(:,jpj) = 0._wp 248 246 ENDIF 249 247 ! 250 248 IF( lk_mpp ) THEN ! mpp specificities 251 249 ! ! bmask is set to zero on the overlap region 252 IF( nbondi /= -1 .AND. nbondi /= 2 ) bmask( 1 :jpreci,:) = 0. e0253 IF( nbondi /= 1 .AND. nbondi /= 2 ) bmask(nlci:jpi ,:) = 0. e0254 IF( nbondj /= -1 .AND. nbondj /= 2 ) bmask(:, 1 :jprecj) = 0. e0255 IF( nbondj /= 1 .AND. nbondj /= 2 ) bmask(:,nlcj:jpj ) = 0. e0250 IF( nbondi /= -1 .AND. nbondi /= 2 ) bmask( 1 :jpreci,:) = 0._wp 251 IF( nbondi /= 1 .AND. nbondi /= 2 ) bmask(nlci:jpi ,:) = 0._wp 252 IF( nbondj /= -1 .AND. nbondj /= 2 ) bmask(:, 1 :jprecj) = 0._wp 253 IF( nbondj /= 1 .AND. nbondj /= 2 ) bmask(:,nlcj:jpj ) = 0._wp 256 254 ! 257 255 IF( npolj == 3 .OR. npolj == 4 ) THEN ! north fold : bmask must be set to 0. on rows jpj-1 and jpj … … 259 257 ii = ji + nimpp - 1 260 258 bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii) 261 bmask(ji,nlcj ) = 0. e0259 bmask(ji,nlcj ) = 0._wp 262 260 END DO 263 261 ENDIF 264 262 IF( npolj == 5 .OR. npolj == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 265 263 DO ji = 1, nlci 266 bmask(ji,nlcj ) = 0. e0264 bmask(ji,nlcj ) = 0._wp 267 265 END DO 268 266 ENDIF … … 281 279 DO jj = 2, jpjm1 282 280 DO ji = fs_2, fs_jpim1 ! vector opt. 283 IF( fmask(ji,jj,jk) == 0. ) THEN284 fmask(ji,jj,jk) = rn_shlat * MIN( 1. , MAX( zwf(ji+1,jj), zwf(ji,jj+1), &285 & zwf(ji-1,jj), zwf(ji,jj-1) ) )281 IF( fmask(ji,jj,jk) == 0._wp ) THEN 282 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 283 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 286 284 ENDIF 287 285 END DO 288 286 END DO 289 287 DO jj = 2, jpjm1 290 IF( fmask(1,jj,jk) == 0. ) THEN291 fmask(1 ,jj,jk) = rn_shlat * MIN( 1. , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )292 ENDIF 293 IF( fmask(jpi,jj,jk) == 0. ) THEN294 fmask(jpi,jj,jk) = rn_shlat * MIN( 1. , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )288 IF( fmask(1,jj,jk) == 0._wp ) THEN 289 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 290 ENDIF 291 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 292 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 295 293 ENDIF 296 294 END DO 297 295 DO ji = 2, jpim1 298 IF( fmask(ji,1,jk) == 0. ) THEN299 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1. , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )300 ENDIF 301 IF( fmask(ji,jpj,jk) == 0. ) THEN302 fmask(ji,jpj,jk) = rn_shlat * MIN( 1. , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )296 IF( fmask(ji,1,jk) == 0._wp ) THEN 297 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 298 ENDIF 299 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 300 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 303 301 ENDIF 304 302 END DO … … 310 308 ! ! Gibraltar strait : partial slip (fmask=0.5) 311 309 ij0 = 101 ; ij1 = 101 312 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5 e0310 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 313 311 ij0 = 102 ; ij1 = 102 314 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5 e0312 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 315 313 ! 316 314 ! ! Bab el Mandeb : partial slip (fmask=1) 317 315 ij0 = 87 ; ij1 = 88 318 ii0 = 160 ; ii1 = 160 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1. e0316 ii0 = 160 ; ii1 = 160 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 319 317 ij0 = 88 ; ij1 = 88 320 ii0 = 159 ; ii1 = 159 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1. e0318 ii0 = 159 ; ii1 = 159 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 321 319 ! 322 320 ENDIF … … 324 322 ! We keep this as an example but it is instable in this case 325 323 ! ij0 = 115 ; ij1 = 115 326 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4. 0e0324 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 327 325 ! ij0 = 116 ; ij1 = 116 328 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4. 0e0326 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 329 327 ! 330 328 ENDIF … … 336 334 IF(lwp) WRITE(numout,*) ' Gibraltar ' 337 335 ii0 = 283 ; ii1 = 284 ! Gibraltar Strait 338 ij0 = 200 ; ij1 = 200 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2. 0336 ij0 = 200 ; ij1 = 200 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp 339 337 340 338 IF(lwp) WRITE(numout,*) ' Bhosporus ' 341 339 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait 342 ij0 = 208 ; ij1 = 208 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2. 0340 ij0 = 208 ; ij1 = 208 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp 343 341 344 342 IF(lwp) WRITE(numout,*) ' Makassar (Top) ' 345 343 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) 346 ij0 = 149 ; ij1 = 150 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3. 0344 ij0 = 149 ; ij1 = 150 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp 347 345 348 346 IF(lwp) WRITE(numout,*) ' Lombok ' 349 347 ii0 = 44 ; ii1 = 44 ! Lombok Strait 350 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2. 0348 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp 351 349 352 350 IF(lwp) WRITE(numout,*) ' Ombai ' 353 351 ii0 = 53 ; ii1 = 53 ! Ombai Strait 354 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2. 0352 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp 355 353 356 354 IF(lwp) WRITE(numout,*) ' Timor Passage ' 357 355 ii0 = 56 ; ii1 = 56 ! Timor Passage 358 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2. 0356 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp 359 357 360 358 IF(lwp) WRITE(numout,*) ' West Halmahera ' 361 359 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait 362 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3. 0360 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp 363 361 364 362 IF(lwp) WRITE(numout,*) ' East Halmahera ' 365 363 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait 366 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3. 0364 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp 367 365 ! 368 366 ENDIF 369 367 ! 370 CALL lbc_lnk( fmask, 'F', 1. ) ! Lateral boundary conditions on fmask 371 372 373 ! Mbathy set to the number of w-level (minimum value 2) 374 ! ----------------------------------- 375 DO jj = 1, jpj 376 DO ji = 1, jpi 377 mbathy(ji,jj) = MAX( 1, mbathy(ji,jj) ) + 1 378 END DO 379 END DO 380 368 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 369 370 381 371 IF( nprint == 1 .AND. lwp ) THEN ! Control print 382 372 imsk(:,:) = INT( tmask_i(:,:) ) … … 421 411 imsk(:,:) = INT( bmask(:,:) ) 422 412 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, & 423 &1, jpj, 1, 1, numout )413 & 1, jpj, 1, 1, numout ) 424 414 ENDIF 425 415 ! … … 440 430 !! 441 431 !! ** Action : 442 !!443 432 !!---------------------------------------------------------------------- 444 433 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 484 473 zaa = tmask(ji ,jj,jk) + tmask(ji ,jj+1,jk) & 485 474 &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) 486 IF( ABS(zaa-3. ) <= 0.1 ) fmask(ji,jj,jk) = 1.475 IF( ABS(zaa-3._wp) <= 0.1_wp ) fmask(ji,jj,jk) = 1._wp 487 476 END DO 488 477 END DO … … 497 486 DO ji = 2, jpim1 498 487 zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) 499 IF( ABS(zaa-2. ) <= 0.1 .AND. fmask(ji,jj,jk) == 0) THEN488 IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 500 489 inw = inw + 1 501 490 nicoa(inw,1,jk) = ji … … 504 493 ENDIF 505 494 zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk) 506 IF( ABS(zaa-2. ) <= 0.1 .AND. fmask(ji,jj,jk) == 0) THEN495 IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 507 496 ine = ine + 1 508 497 nicoa(ine,2,jk) = ji … … 524 513 DO ji =2, jpim1 525 514 zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) 526 IF( ABS(zaa-2. ) <= 0.1 .AND. fmask(ji,jj,jk) == 0) THEN515 IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 527 516 ins = ins + 1 528 517 nicoa(ins,3,jk) = ji … … 531 520 ENDIF 532 521 zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk) 533 IF( ABS(zaa-2. ) <= 0.1 .AND. fmask(ji,jj,jk) == 0) THEN522 IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 534 523 inn = inn + 1 535 524 nicoa(inn,4,jk) = ji … … 560 549 iind = 0 561 550 ijnd = 0 562 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) iind = 2563 IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 ) ijnd = 2551 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) iind = 2 552 IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 ) ijnd = 2 564 553 DO jk = 1, jpk 565 554 DO jl = 1, npcoa(1,jk) … … 587 576 ENDIF 588 577 END DO 589 DO jl =1,npcoa(4,jk)578 DO jl = 1, npcoa(4,jk) 590 579 IF( njcoa(jl,4,jk)-2 < 1) THEN 591 ierror=ierror +1592 icoord(ierror,1) =nicoa(jl,4,jk)593 icoord(ierror,2) =njcoa(jl,4,jk)594 icoord(ierror,3) =jk580 ierror=ierror + 1 581 icoord(ierror,1) = nicoa(jl,4,jk) 582 icoord(ierror,2) = njcoa(jl,4,jk) 583 icoord(ierror,3) = jk 595 584 ENDIF 596 585 END DO -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2443 r2460 300 300 !! ntopo= 1 : mbathy is read in 'bathy_level.nc' NetCDF file 301 301 !! bathy is read in 'bathy_meter.nc' NetCDF file 302 !! C A U T I O N : mbathy will be modified during the initializa-303 !! tion phase to become the number of non-zero w-levels of a water304 !! column, with a minimum value of 1.305 302 !! 306 303 !! ** Action : - mbathy: level bathymetry (in level index) -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r2287 r2460 4 4 !! Ocean dynamics : bottom friction component of the momentum mixing trend 5 5 !!============================================================================== 6 !! History : 9.0 !2008-11 (A. C. Coward) Original code6 !! History : 3.2 ! 2008-11 (A. C. Coward) Original code 7 7 !!---------------------------------------------------------------------- 8 8 … … 32 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 33 !! $Id$ 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 37 36 CONTAINS 38 37 … … 45 44 !! ** Action : (ua,va) momentum trend increased by bottom friction trend 46 45 !!--------------------------------------------------------------------- 47 USE oce, ONLY : ztrdu => ta ! use ta as 3D workspace 48 USE oce, ONLY : ztrdv => sa ! use sa as 3D workspace 46 USE oce, ONLY : ztrduv => tsa ! use tsa as 4D workspace 49 47 !! 50 48 INTEGER, INTENT(in) :: kt ! ocean time-step index 51 49 !! 52 INTEGER :: ji, jj ! dummy loop indexes 53 INTEGER :: ikbu , ikbv ! temporary integers 54 INTEGER :: ikbum1, ikbvm1 ! - - 55 REAL(wp) :: zinv, zbfru, zbfrv ! temporary scalar 50 INTEGER :: ji, jj ! dummy loop indexes 51 INTEGER :: ikbu, ikbv ! local integers 52 REAL(wp) :: zm1_2dt ! local scalar 56 53 !!--------------------------------------------------------------------- 57 54 ! 58 z inv = -1. / ( 2.*rdt )55 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 59 56 60 57 IF( l_trddyn ) THEN ! temporary save of ua and va trends 61 ztrdu (:,:,:) = ua(:,:,:)62 ztrd v(:,:,:) = va(:,:,:)58 ztrduv(:,:,:,1) = ua(:,:,:) 59 ztrduv(:,:,:,2) = va(:,:,:) 63 60 ENDIF 64 61 … … 70 67 DO ji = 2, jpim1 71 68 # endif 72 ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) ) 73 ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) ) 74 ikbum1 = MAX( ikbu-1, 1 ) 75 ikbvm1 = MAX( ikbv-1, 1 ) 69 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 70 ikbv = mbkv(ji,jj) 76 71 ! 77 ! Apply stability criteria on absolute value : Min abs(bfr) => Max (bfr) 78 zbfru = MAX( bfrua(ji,jj), fse3u(ji,jj,ikbu)*zinv ) 79 zbfrv = MAX( bfrva(ji,jj), fse3v(ji,jj,ikbv)*zinv ) 80 ! 81 ua(ji,jj,ikbum1) = ua(ji,jj,ikbum1) + zbfru * ub(ji,jj,ikbum1) / fse3u(ji,jj,ikbu) 82 va(ji,jj,ikbvm1) = va(ji,jj,ikbvm1) + zbfrv * vb(ji,jj,ikbvm1) / fse3v(ji,jj,ikbv) 83 ! 72 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 73 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) 74 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrua(ji,jj) / fse3v(ji,jj,ikbu) , zm1_2dt ) * vb(ji,jj,ikbv) 84 75 END DO 85 76 END DO … … 87 78 ! 88 79 IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics 89 ztrdu (:,:,:) = ua(:,:,:) - ztrdu(:,:,:)90 ztrd v(:,:,:) = va(:,:,:) - ztrdv(:,:,:)91 CALL trd_mod( ztrdu , ztrdv, jpdyn_trd_bfr, 'DYN', kt )80 ztrduv(:,:,:,1) = ua(:,:,:) - ztrduv(:,:,:,1) 81 ztrduv(:,:,:,2) = va(:,:,:) - ztrduv(:,:,:,2) 82 CALL trd_mod( ztrduv(:,:,:,1), ztrduv(:,:,:,2), jpdyn_trd_bfr, 'DYN', kt ) 92 83 ENDIF 93 84 ! ! print mean trends (used for debugging) -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r2338 r2460 97 97 INTEGER :: ji, jj, jk, jn ! dummy loop indices 98 98 INTEGER :: icycle ! temporary scalar 99 INTEGER :: ikbu, ikbv ! temporary scalar100 99 101 100 REAL(wp) :: zraur, zcoef, z2dt_e, z2dt_b ! temporary scalars … … 265 264 DO ji = 2, jpim1 266 265 # endif 267 ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )268 ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )269 !270 266 ! Apply stability criteria for bottom friction 271 !RBbug for vvl and external mode we may need to 272 ! use varying fse3273 zbfru (ji,jj) = MAX( bfrua(ji,jj), fse3u(ji,jj,ikbu)*zcoef)274 zbfrv (ji,jj) = MAX( bfrva(ji,jj), fse3v(ji,jj,ikbv)*zcoef)267 !RBbug for vvl and external mode we may need to use varying fse3 268 !!gm Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx. 269 zbfru(ji,jj) = MAX( bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef ) 270 zbfrv(ji,jj) = MAX( bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef ) 275 271 END DO 276 272 END DO
Note: See TracChangeset
for help on using the changeset viewer.
