Changeset 990 for branches/dev_003_CPL/NEMO/LIM_SRC_3/limadv.F90
- Timestamp:
- 2008-05-23T16:38:21+02:00 (16 years ago)
- File:
-
- 1 edited
-
branches/dev_003_CPL/NEMO/LIM_SRC_3/limadv.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_003_CPL/NEMO/LIM_SRC_3/limadv.F90
r888 r990 66 66 pdf , & ! ??? 67 67 pcrh ! = 1. : lim_adv_x is called before lim_adv_y 68 68 ! ! = 0. : lim_adv_x is called after lim_adv_y 69 69 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: & 70 70 put ! i-direction ice velocity at ocean U-point (m/s) … … 114 114 ! Calculate fluxes and moments between boxes i<-->i+1 115 115 DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0 116 !i bug DO ji = 1, jpim1117 !i DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0116 !i bug DO ji = 1, jpim1 117 !i DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0 118 118 DO ji = 1, jpi 119 119 zbet(ji,jj) = MAX( rzero, SIGN( rone, put(ji,jj) ) ) … … 142 142 143 143 DO jj = 1, jpjm1 ! Flux from i+1 to i when u LT 0. 144 !i DO jj = 1, fs_jpjm1 ! Flux from i+1 to i when u LT 0.144 !i DO jj = 1, fs_jpjm1 ! Flux from i+1 to i when u LT 0. 145 145 DO ji = 1, fs_jpim1 146 146 zalf = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) … … 228 228 CALL lbc_lnk( psxy, 'T', 1. ) 229 229 230 IF(ln_ctl) THEN230 IF(ln_ctl) THEN 231 231 CALL prt_ctl(tab2d_1=psm , clinfo1=' lim_adv_x: psm :', tab2d_2=ps0 , clinfo2=' ps0 : ') 232 232 CALL prt_ctl(tab2d_1=psx , clinfo1=' lim_adv_x: psx :', tab2d_2=psxx, clinfo2=' psxx : ') 233 233 CALL prt_ctl(tab2d_1=psy , clinfo1=' lim_adv_x: psy :', tab2d_2=psyy, clinfo2=' psyy : ') 234 234 CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :') 235 ENDIF235 ENDIF 236 236 237 237 END SUBROUTINE lim_adv_x … … 260 260 pdf, & ! ??? 261 261 pcrh ! = 1. : lim_adv_x is called before lim_adv_y 262 262 ! ! = 0. : lim_adv_x is called after lim_adv_y 263 263 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: & 264 264 pvt ! j-direction ice velocity at ocean V-point (m/s) … … 285 285 zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 286 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 !!bug DO jj = 2, jpjm1309 310 311 !!bug DO ji = 1, jpim1312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 !i DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0.340 !i DO ji = 2, jpim1341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 287 DO jj = 1, jpj 288 DO ji = 1, jpi 289 zslpmax = MAX( rzero, ps0(ji,jj) ) 290 zs1max = 1.5 * zslpmax 291 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 292 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 293 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 294 zin0 = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 295 ps0 (ji,jj) = zslpmax 296 psx (ji,jj) = psx (ji,jj) * zin0 297 psxx(ji,jj) = psxx(ji,jj) * zin0 298 psy (ji,jj) = zs1new * zin0 299 psyy(ji,jj) = zs2new * zin0 300 psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 301 END DO 302 END DO 303 304 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 305 psm (:,:) = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 306 307 ! Calculate fluxes and moments between boxes j<-->j+1 308 !!bug DO jj = 2, jpjm1 309 DO jj = 1, jpj 310 DO ji = 1, jpi 311 !!bug DO ji = 1, jpim1 312 ! Flux from j to j+1 WHEN v GT 0 313 zbet(ji,jj) = MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 314 zalf = MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 315 zalfq = zalf * zalf 316 zalf1 = 1.0 - zalf 317 zalf1q = zalf1 * zalf1 318 zfm (ji,jj) = zalf * psm(ji,jj) 319 zf0 (ji,jj) = zalf * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj) + (zalf1-zalf) * psyy(ji,jj) ) ) 320 zfy (ji,jj) = zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) ) 321 zfyy(ji,jj) = zalf * zalfq * psyy(ji,jj) 322 zfx (ji,jj) = zalf * ( psx(ji,jj) + zalf1 * psxy(ji,jj) ) 323 zfxy(ji,jj) = zalfq * psxy(ji,jj) 324 zfxx(ji,jj) = zalf * psxx(ji,jj) 325 326 ! Readjust moments remaining in the box. 327 psm (ji,jj) = psm (ji,jj) - zfm(ji,jj) 328 ps0 (ji,jj) = ps0 (ji,jj) - zf0(ji,jj) 329 psy (ji,jj) = zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) ) 330 psyy(ji,jj) = zalf1 * zalf1q * psyy(ji,jj) 331 psx (ji,jj) = psx (ji,jj) - zfx(ji,jj) 332 psxx(ji,jj) = psxx(ji,jj) - zfxx(ji,jj) 333 psxy(ji,jj) = zalf1q * psxy(ji,jj) 334 END DO 335 END DO 336 337 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 338 DO ji = 1, jpi 339 !i DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 340 !i DO ji = 2, jpim1 341 zalf = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 342 zalg (ji,jj) = zalf 343 zalfq = zalf * zalf 344 zalf1 = 1.0 - zalf 345 zalg1 (ji,jj) = zalf1 346 zalf1q = zalf1 * zalf1 347 zalg1q(ji,jj) = zalf1q 348 zfm (ji,jj) = zfm (ji,jj) + zalf * psm(ji,jj+1) 349 zf0 (ji,jj) = zf0 (ji,jj) + zalf * ( ps0(ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) ) 350 zfy (ji,jj) = zfy (ji,jj) + zalfq * ( psy(ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) ) 351 zfyy (ji,jj) = zfyy(ji,jj) + zalf * zalfq * psyy(ji,jj+1) 352 zfx (ji,jj) = zfx (ji,jj) + zalf * ( psx(ji,jj+1) - zalf1 * psxy(ji,jj+1) ) 353 zfxy (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1) 354 zfxx (ji,jj) = zfxx(ji,jj) + zalf * psxx(ji,jj+1) 355 END DO 356 END DO 357 358 ! Readjust moments remaining in the box. 359 DO jj = 2, jpj 360 DO ji = 1, jpi 361 zbt = zbet(ji,jj-1) 362 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 363 psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) ) 364 ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) ) 365 psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) ) 366 psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj) 367 psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) ) 368 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) ) 369 psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj) 370 END DO 371 END DO 372 373 ! Put the temporary moments into appropriate neighboring boxes. 374 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 375 DO ji = 1, jpi 376 zbt = zbet(ji,jj-1) 377 zbt1 = ( 1.0 - zbet(ji,jj-1) ) 378 psm(ji,jj) = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 379 zalf = zbt * zfm(ji,jj-1) / psm(ji,jj) 380 zalf1 = 1.0 - zalf 381 ztemp = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1) 382 ps0(ji,jj) = zbt * (ps0(ji,jj) + zf0(ji,jj-1)) + zbt1 * ps0(ji,jj) 383 384 psy(ji,jj) = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) & 385 & + zbt1 * psy(ji,jj) 386 387 psyy(ji,jj) = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj) & 388 & + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 389 & + zbt1 * psyy(ji,jj) 390 391 psxy(ji,jj) = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj) & 392 + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) ) & 393 + zbt1 * psxy(ji,jj) 394 psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj) 395 psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj) 396 END DO 397 END DO 398 399 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 400 DO ji = 1, jpi 401 zbt = zbet(ji,jj) 402 zbt1 = ( 1.0 - zbet(ji,jj) ) 403 psm(ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 404 zalf = zbt1 * zfm(ji,jj) / psm(ji,jj) 405 zalf1 = 1.0 - zalf 406 ztemp = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj) 407 ps0(ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) ) 408 psy(ji,jj) = zbt * psy(ji,jj) & 409 & + zbt1 * ( zalf*zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) 410 psyy(ji,jj) = zbt * psyy(ji,jj) & 411 & + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj) & 412 & + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) + ( zalf1 - zalf ) * ztemp ) ) 413 psxy(ji,jj) = zbt * psxy(ji,jj) & 414 & + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj) & 415 & + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) ) 416 psx(ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) ) 417 psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) ) 418 END DO 419 END DO 420 420 421 421 !-- Lateral boundary conditions … … 428 428 CALL lbc_lnk( psxy, 'T', 1. ) 429 429 430 IF(ln_ctl) THEN430 IF(ln_ctl) THEN 431 431 CALL prt_ctl(tab2d_1=psm , clinfo1=' lim_adv_y: psm :', tab2d_2=ps0 , clinfo2=' ps0 : ') 432 432 CALL prt_ctl(tab2d_1=psx , clinfo1=' lim_adv_y: psx :', tab2d_2=psxx, clinfo2=' psxx : ') 433 433 CALL prt_ctl(tab2d_1=psy , clinfo1=' lim_adv_y: psy :', tab2d_2=psyy, clinfo2=' psyy : ') 434 434 CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_y: psxy :') 435 ENDIF435 ENDIF 436 436 437 437 END SUBROUTINE lim_adv_y
Note: See TracChangeset
for help on using the changeset viewer.
