Changeset 32 for trunk/NEMO/OPA_SRC/OBC/obcspg.F90
- Timestamp:
- 2004-02-17T10:20:15+01:00 (21 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/OBC/obcspg.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/OBC/obcspg.F90
r3 r32 5 5 !! open boundary 6 6 !!====================================================================== 7 #if defined key_obc &&defined key_dynspg_rl7 #if defined key_obc && defined key_dynspg_rl 8 8 !!---------------------------------------------------------------------- 9 9 !! 'key_obc' and Open Boundary Condition … … 86 86 !!---------------------------------------------------------------------- 87 87 88 ! 0. Local constant initialization 89 ! -------------------------------- 90 91 IF( kt == nit000 .OR. ln_rstart ) THEN 88 IF( kt == nit000 .OR. ln_rstart ) THEN ! Initialization 92 89 ! ... Boundary restoring coefficient 93 90 rtaue = 2. * rdt / rdpeob … … 100 97 rtaunin = 2. * rdt / rdpnin 101 98 rtausin = 2. * rdt / rdpsin 102 END IF 103 104 ! ... right hand side of the barotropic elliptic equation 99 ENDIF 100 101 ! right hand side of the barotropic elliptic equation 102 ! --------------------------------------------------- 103 104 ! Isolated coastline contribution to the RHS of the barotropic Eq. 105 105 gcbob(:,:) = 0.e0 106 107 ! 1. Isolated coastline contribution to the RHS of the barotropic Eq.108 ! -------------------------------------------------------------------109 106 DO jnic = 1, nbobc-1 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 gcbob(ji,jj) = gcbob(ji,jj) + gcfobc(ji,jj,jnic) * gcbic(jnic) 113 END DO 114 END DO 107 gcbob(:,:) = gcbob(:,:) + gcfobc(:,:,jnic) * gcbic(jnic) 115 108 END DO 116 109 117 ! 2. East open boundary 118 ! --------------------- 119 120 IF( lpeastobc ) THEN 121 CALL obc_spg_east( kt ) 122 END IF 123 124 ! 3. West open boundary 125 ! --------------------- 126 127 IF( lpwestobc ) THEN 128 CALL obc_spg_west( kt ) 129 END IF 130 131 ! 4. North open boundary 132 ! ---------------------- 133 134 IF( lpnorthobc ) THEN 135 CALL obc_spg_north( kt ) 136 END IF 137 138 ! 5. South open boundary 139 ! ---------------------- 140 141 IF( lpsouthobc ) THEN 142 CALL obc_spg_south( kt ) 143 END IF 144 145 # if defined key_mpp 146 CALL mpp_lnk_2d( gcbob, 'G', 1. ) 147 # endif 110 IF( lpeastobc ) CALL obc_spg_east ( kt ) ! East open boundary 111 112 IF( lpwestobc ) CALL obc_spg_west ( kt ) ! West open boundary 113 114 IF( lpnorthobc ) CALL obc_spg_north( kt ) ! North open boundary 115 116 IF( lpsouthobc ) CALL obc_spg_south( kt ) ! South open boundary 117 118 IF( lk_mpp ) CALL lbc_lnk( gcbob, 'G', 1. ) 148 119 149 120 END SUBROUTINE obc_spg 150 121 122 151 123 SUBROUTINE obc_spg_east ( kt ) 152 124 !!------------------------------------------------------------------------------ 153 !! SUBROUTINE obc_spg_east 154 !! ************************* 155 !! ** Purpose : 156 !! Apply the radiation algorithm on east OBC stream function. 157 !! If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC 125 !! *** SUBROUTINE obc_spg_east *** 126 !! 127 !! ** Purpose : Apply the radiation algorithm on east OBC stream function. 128 !! If lfbceast=T , there is no radiation but only fixed OBC 158 129 !! 159 130 !! History : … … 169 140 !! * Local declarations 170 141 INTEGER :: ij 171 172 142 REAL(wp) :: z2dtr, ztau, zin 173 143 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 174 175 !!------------------------------------------------------------------------------176 !! OPA 8.5, LODYC-IPSL (2002)177 144 !!------------------------------------------------------------------------------ 178 145 … … 229 196 IF(lwp) WRITE(numout,*)' PB dans obc_spg_east au pt ',jj,' : z4nor=0' 230 197 z4nor2 = 0.001 231 END 198 ENDIF 232 199 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 233 200 z05cx = z05cx / e1v(ji+1,jj) … … 249 216 END DO 250 217 251 END IF 252 # if defined key_mpp 253 CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj) 254 # endif 218 ENDIF 219 IF( lk_mpp ) CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj) 220 255 221 256 222 ! 3. right hand side of the barotropic elliptic equation … … 258 224 259 225 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 260 z2dtr =1./rdt226 z2dtr = 1.0 / rdt 261 227 ELSE 262 z2dtr =1./2./rdt263 END 228 z2dtr = 0.5 / rdt 229 ENDIF 264 230 DO ji = fs_nie0-1, fs_nie1-1 ! Vector opt. 265 231 DO jj = nje0m1, nje1 … … 351 317 IF(lwp) WRITE(numout,*)' PB dans obc_spg_west au pt ',jj,' : z4nor =0' 352 318 z4nor2=0.0001 353 END 319 ENDIF 354 320 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 355 321 z05cx = z05cx / e1v(ji,jj) … … 368 334 END DO 369 335 370 END IF 371 # if defined key_mpp 372 CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj) 373 # endif 336 ENDIF 337 IF( lk_mpp ) CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj) 338 374 339 375 340 ! 3. right hand side of the barotropic elliptic equation … … 377 342 378 343 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 379 z2dtr =1./rdt344 z2dtr = 1.0 / rdt 380 345 ELSE 381 z2dtr =1./2./rdt382 END 346 z2dtr = 0.5 / rdt 347 ENDIF 383 348 DO ji = fs_niw0+1, fs_niw1+1 ! Vector opt. 384 349 DO jj = njw0m1, njw1 … … 392 357 SUBROUTINE obc_spg_north ( kt ) 393 358 !!------------------------------------------------------------------------------ 394 !! SUBROUTINE obc_spg_north 395 !! ************************* 396 !! ** Purpose : 397 !! Apply the radiation algorithm on north OBC stream function. 398 !! If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC 359 !! *** SUBROUTINE obc_spg_north *** 360 !! 361 !! ** Purpose : Apply the radiation algorithm on north OBC stream function. 362 !! If lfbcnorth=T, there is no radiation but only fixed OBC 399 363 !! 400 364 !! History : … … 410 374 !! * Local declarations 411 375 INTEGER :: ii 412 413 376 REAL(wp) :: z2dtr, ztau, zin 414 377 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 415 416 !!------------------------------------------------------------------------------417 !! OPA 8.5, LODYC-IPSL (2002)418 378 !!------------------------------------------------------------------------------ 419 379 … … 475 435 IF( z4nor2 == 0 ) THEN 476 436 IF(lwp) WRITE(numout,*)' PB dans obc_spg_north au pt',ji,' : z4nor =0' 477 END 437 ENDIF 478 438 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 479 439 z05cx = z05cx / e2u(ji,jj+1) … … 492 452 END DO 493 453 494 END IF 495 # if defined key_mpp 496 call mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi) 497 # endif 454 ENDIF 455 IF( lk_mpp ) CALL mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi) 456 498 457 499 458 ! 3. right hand side of the barotropic elliptic equation … … 501 460 502 461 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 503 z2dtr =1./rdt462 z2dtr = 1.0 / rdt 504 463 ELSE 505 z2dtr =1./2./rdt506 END 464 z2dtr = 0.5 / rdt 465 ENDIF 507 466 DO jj = fs_njn0-1, fs_njn1-1 ! Vector opt. 508 467 DO ji = nin0m1, nin1 … … 514 473 END SUBROUTINE obc_spg_north 515 474 475 516 476 SUBROUTINE obc_spg_south ( kt ) 517 477 !!------------------------------------------------------------------------------ 518 !! SUBROUTINE obc_spg_south 519 !! ************************* 520 !! ** Purpose : 521 !! Apply the radiation algorithm on south OBC stream function. 522 !! If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC 478 !! *** SUBROUTINE obc_spg_south *** 479 !! 480 !! ** Purpose : Apply the radiation algorithm on south OBC stream function. 481 !! If lfbcsouth=T, there is no radiation but only fixed OBC 523 482 !! 524 483 !! History : … … 596 555 IF( z4nor2 == 0 ) THEN 597 556 IF(lwp) WRITE(numout,*)' PB dans obc_spg_south au pt ',ji,' : z4nor =0' 598 END 557 ENDIF 599 558 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 600 559 z05cx = z05cx / e2u(ji,jj) … … 613 572 END DO 614 573 615 END IF 616 # if defined key_mpp 617 CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi) 618 # endif 574 ENDIF 575 IF( lk_mpp ) CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi) 576 619 577 620 578 ! 3. right hand side of the barotropic elliptic equation 621 579 ! ------------------------------------------------------- 622 580 623 IF( ( neuler == 0 ) . and. ( kt == nit000 ) ) THEN624 z2dtr =1./rdt581 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 582 z2dtr = 1.0 / rdt 625 583 ELSE 626 z2dtr =1./2./rdt627 END 584 z2dtr = 0.5 / rdt 585 ENDIF 628 586 DO jj = fs_njs0+1, fs_njs1+1 ! Vector opt. 629 587 DO ji = nis0m1, nis1 … … 642 600 SUBROUTINE obc_spg( kt ) ! Empty routine 643 601 INTEGER, INTENT( in ) :: kt 644 WRITE(*,*) kt602 WRITE(*,*) 'obc_spg: You should not have seen this print! error?', kt 645 603 END SUBROUTINE obc_spg 646 604 #endif
Note: See TracChangeset
for help on using the changeset viewer.
