Changeset 389 for trunk/NEMO/OPA_SRC/DOM
- Timestamp:
- 2006-03-09T18:22:04+01:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DOM
- Files:
-
- 6 edited
-
dom_oce.F90 (modified) (1 diff)
-
domain.F90 (modified) (5 diffs)
-
domhgr.F90 (modified) (21 diffs)
-
domwri.F90 (modified) (2 diffs)
-
domzgr.F90 (modified) (4 diffs)
-
domzgr_zps.h90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/dom_oce.F90
r359 r389 197 197 ! ! parameterize exchanges through straits 198 198 199 !!---------------------------------------------------------------------- 199 #if defined key_AGRIF 200 !!---------------------------------------------------------------------- 201 !! agrif sponge layer 202 !!---------------------------------------------------------------------- 203 LOGICAL :: spongedoneT = .FALSE. 204 REAL(wp), DIMENSION(jpi,jpj) :: zspe1ur, zspe2vr ,zspbtr2 205 !!---------------------------------------------------------------------- 206 #endif 207 200 208 END MODULE dom_oce -
trunk/NEMO/OPA_SRC/DOM/domain.F90
r359 r389 97 97 hu(:,:) = 0. 98 98 hv(:,:) = 0. 99 99 100 DO jk = 1, jpk 100 101 hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk) … … 104 105 hur(:,:) = fse3u(:,:,1) ! Lower bound : thickness of the first model level 105 106 hvr(:,:) = fse3v(:,:,1) 107 106 108 DO jk = 2, jpk ! Sum of the vertical scale factors 107 109 hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk) 108 110 hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) 109 111 END DO 112 110 113 ! Compute and mask the inverse of the local depth 111 114 hur(:,:) = 1. / hur(:,:) * umask(:,:,1) … … 137 140 !! * Modules used 138 141 USE ioipsl 139 NAMELIST/namrun/ no , cexper , ln_rstart , nrstdt , nit000, 140 & nitend, ndate0 , nleapy , ninist , nstock, 142 NAMELIST/namrun/ no , cexper , ln_rstart , nrstdt , nit000, & 143 & nitend, ndate0 , nleapy , ninist , nstock, & 141 144 & nprint, nwrite , nrunoff , ln_ctl , nictls, nictle, & 142 145 & njctls, njctle , nbench , isplt , jsplt … … 261 264 ENDIF 262 265 266 #if defined key_AGRIF 267 if ( Agrif_Root() ) then 268 #endif 263 269 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 264 270 CASE ( 1 ) … … 272 278 IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year' 273 279 END SELECT 280 #if defined key_AGRIF 281 endif 282 #endif 274 283 275 284 SELECT CASE ( nleapy ) ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ... -
trunk/NEMO/OPA_SRC/DOM/domhgr.F90
r352 r389 110 110 zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg, & 111 111 zphi1, zsin_alpha, zim05, zjm05 112 113 real,dimension(:,:),pointer :: ffparent 112 114 !!---------------------------------------------------------------------- 113 115 … … 233 235 glam0 = 0.e0 234 236 gphi0 = - ppe2_m * 1.e-3 237 238 #if defined key_AGRIF && defined key_eel_r6 239 IF (.Not.Agrif_Root()) THEN 240 glam0 = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 241 gphi0 = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 242 ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox() 243 ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy() 244 ENDIF 245 #endif 235 246 DO jj = 1, jpj 236 247 DO ji = 1, jpi … … 422 433 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 423 434 zphi0 = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad ) ! latitude of the first row F-points 435 436 #if defined key_AGRIF && defined key_eel_r6 437 IF (.Not.Agrif_Root()) THEN 438 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 439 ENDIF 440 #endif 424 441 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 425 442 426 443 ff(:,:) = ( zf0 + zbeta * gphif(:,:) * 1.e+3 ) ! f = f0 +beta* y ( y=0 at south) 427 444 428 445 IF(lwp) WRITE(numout,*) 429 446 IF(lwp) WRITE(numout,*) ' Beta-plane: Beta parameter = constant = ', ff(1,1) … … 486 503 !! * Local declarations 487 504 LOGICAL :: llog = .FALSE. 488 CHARACTER(len=21) :: clname = 'coordinates'505 CHARACTER(len=21) :: clname 489 506 INTEGER :: ji, jj ! dummy loop indices 490 507 INTEGER :: inum ! temporary logical unit … … 495 512 zlamt, zphit, zdta ! temporary workspace (NetCDF read) 496 513 !!---------------------------------------------------------------------- 514 clname = 'coordinates' 515 #if defined key_AGRIF 516 if ( .NOT. Agrif_Root() ) then 517 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 518 endif 519 #endif 497 520 498 521 … … 515 538 & itime , zdate0, zdt , inum, domain_id=nidom ) 516 539 517 CALL restget( inum, 'glamt', jpidta, jpjdta, 1, 0, llog, zdta )540 CALL restget( inum, 'glamt', jpidta, jpjdta, 1, itime, llog, zdta ) 518 541 DO jj = 1, nlcj 519 542 DO ji = 1, nlci … … 521 544 END DO 522 545 END DO 523 CALL restget( inum, 'glamu', jpidta, jpjdta, 1, 0, llog, zdta )546 CALL restget( inum, 'glamu', jpidta, jpjdta, 1, itime, llog, zdta ) 524 547 DO jj = 1, nlcj 525 548 DO ji = 1, nlci … … 527 550 END DO 528 551 END DO 529 CALL restget( inum, 'glamv', jpidta, jpjdta, 1, 0, llog, zdta )552 CALL restget( inum, 'glamv', jpidta, jpjdta, 1, itime, llog, zdta ) 530 553 DO jj = 1, nlcj 531 554 DO ji = 1, nlci … … 533 556 END DO 534 557 END DO 535 CALL restget( inum, 'glamf', jpidta, jpjdta, 1, 0, llog, zdta )558 CALL restget( inum, 'glamf', jpidta, jpjdta, 1, itime, llog, zdta ) 536 559 DO jj = 1, nlcj 537 560 DO ji = 1, nlci … … 539 562 END DO 540 563 END DO 541 CALL restget( inum, 'gphit', jpidta, jpjdta, 1, 0, llog, zdta )564 CALL restget( inum, 'gphit', jpidta, jpjdta, 1, itime, llog, zdta ) 542 565 DO jj = 1, nlcj 543 566 DO ji = 1, nlci … … 545 568 END DO 546 569 END DO 547 CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, 0, llog, zdta )570 CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, itime, llog, zdta ) 548 571 DO jj = 1, nlcj 549 572 DO ji = 1, nlci … … 551 574 END DO 552 575 END DO 553 CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, 0, llog, zdta )576 CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, itime, llog, zdta ) 554 577 DO jj = 1, nlcj 555 578 DO ji = 1, nlci … … 557 580 END DO 558 581 END DO 559 CALL restget( inum, 'gphif', jpidta, jpjdta, 1, 0, llog, zdta )582 CALL restget( inum, 'gphif', jpidta, jpjdta, 1, itime, llog, zdta ) 560 583 DO jj = 1, nlcj 561 584 DO ji = 1, nlci … … 563 586 END DO 564 587 END DO 565 CALL restget( inum, 'e1t', jpidta, jpjdta, 1, 0, llog, zdta )588 CALL restget( inum, 'e1t', jpidta, jpjdta, 1, itime, llog, zdta ) 566 589 DO jj = 1, nlcj 567 590 DO ji = 1, nlci … … 569 592 END DO 570 593 END DO 571 CALL restget( inum, 'e1u', jpidta, jpjdta, 1, 0, llog, zdta )594 CALL restget( inum, 'e1u', jpidta, jpjdta, 1, itime, llog, zdta ) 572 595 DO jj = 1, nlcj 573 596 DO ji = 1, nlci … … 575 598 END DO 576 599 END DO 577 CALL restget( inum, 'e1v', jpidta, jpjdta, 1, 0, llog, zdta )600 CALL restget( inum, 'e1v', jpidta, jpjdta, 1, itime, llog, zdta ) 578 601 DO jj = 1, nlcj 579 602 DO ji = 1, nlci … … 581 604 END DO 582 605 END DO 583 CALL restget( inum, 'e1f', jpidta, jpjdta, 1, 0, llog, zdta )606 CALL restget( inum, 'e1f', jpidta, jpjdta, 1, itime, llog, zdta ) 584 607 DO jj = 1, nlcj 585 608 DO ji = 1, nlci … … 587 610 END DO 588 611 END DO 589 CALL restget( inum, 'e2t', jpidta, jpjdta, 1, 0, llog, zdta )612 CALL restget( inum, 'e2t', jpidta, jpjdta, 1, itime, llog, zdta ) 590 613 DO jj = 1, nlcj 591 614 DO ji = 1, nlci … … 593 616 END DO 594 617 END DO 595 CALL restget( inum, 'e2u', jpidta, jpjdta, 1, 0, llog, zdta )618 CALL restget( inum, 'e2u', jpidta, jpjdta, 1, itime, llog, zdta ) 596 619 DO jj = 1, nlcj 597 620 DO ji = 1, nlci … … 599 622 END DO 600 623 END DO 601 CALL restget( inum, 'e2v', jpidta, jpjdta, 1, 0, llog, zdta )624 CALL restget( inum, 'e2v', jpidta, jpjdta, 1, itime, llog, zdta ) 602 625 DO jj = 1, nlcj 603 626 DO ji = 1, nlci … … 605 628 END DO 606 629 END DO 607 CALL restget( inum, 'e2f', jpidta, jpjdta, 1, 0, llog, zdta )630 CALL restget( inum, 'e2f', jpidta, jpjdta, 1, itime, llog, zdta ) 608 631 DO jj = 1, nlcj 609 632 DO ji = 1, nlci -
trunk/NEMO/OPA_SRC/DOM/domwri.F90
r352 r389 87 87 88 88 CHARACTER (len=21) :: & 89 clnam0 = 'mesh_mask', & ! filename (mesh and mask informations)90 clnam1 = 'mesh', & ! filename (mesh informations)91 clnam2 = 'mask', & ! filename (mask informations)92 clnam3 = 'mesh_hgr', & ! filename (horizontal mesh informations)93 clnam4 = 'mesh_zgr'! filename (vertical mesh informations)89 clnam0 , & ! filename (mesh and mask informations) 90 clnam1 , & ! filename (mesh informations) 91 clnam2 , & ! filename (mask informations) 92 clnam3 , & ! filename (horizontal mesh informations) 93 clnam4 ! filename (vertical mesh informations) 94 94 !!---------------------------------------------------------------------- 95 95 … … 97 97 IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' 98 98 IF(lwp) WRITE(numout,*) '~~~~~~~' 99 100 clnam0 = 'mesh_mask' ! filename (mesh and mask informations) 101 clnam1 = 'mesh' ! filename (mesh informations) 102 clnam2 = 'mask' ! filename (mask informations) 103 clnam3 = 'mesh_hgr' ! filename (horizontal mesh informations) 104 clnam4 = 'mesh_zgr' ! filename (vertical mesh informations) 105 106 #if defined key_AGRIF 107 if ( .NOT. Agrif_Root() ) then 108 clnam0 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam0) 109 clnam1 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam1) 110 clnam2 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam2) 111 clnam3 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam3) 112 clnam4 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam4) 113 endif 114 #endif 99 115 100 116 CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 ) ! calendar initialization -
trunk/NEMO/OPA_SRC/DOM/domzgr.F90
r381 r389 289 289 290 290 !! * Local declarations 291 CHARACTER (len=1 5) :: clname ! temporary characters291 CHARACTER (len=18) :: clname ! temporary characters 292 292 LOGICAL :: llbon ! check the existence of bathy files 293 293 INTEGER :: ji, jj, jl, jk ! dummy loop indices … … 380 380 ! EEL R5 configuration with east and west open boundaries. 381 381 ! Two rows of zeroes are needed at the south and north for OBCs 382 ! This is for compatibility with the rigid lid option.383 382 384 383 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN … … 390 389 ELSEIF( ntopo == 1 ) THEN ! read in file ! 391 390 ! ! =============== ! 392 IF( lk_zco ) THEN 393 clname = 'bathy_level.nc' ! Level bathymetry 394 INQUIRE( FILE=clname, EXIST=llbon ) 395 IF( llbon ) THEN 396 IF(lwp) WRITE(numout,*) 397 IF(lwp) WRITE(numout,*) ' read level bathymetry in ', clname 398 IF(lwp) WRITE(numout,*) 399 itime = 1 400 ipi = jpidta 401 ipj = jpjdta 402 ipk = 1 403 zdt = rdt 404 CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., & 405 ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 406 CALL flinget( inum, 'Bathy_level', jpidta, jpjdta, 1, & 407 itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 408 idta(:,:) = zdta(:,:) 409 CALL flinclo( inum ) 410 411 ELSE 412 IF(lwp) WRITE(numout,cform_err) 413 IF(lwp) WRITE(numout,*)' zgr_bat : unable to read the file', clname 414 nstop = nstop + 1 415 ENDIF 416 417 ELSEIF( lk_zps ) THEN 418 clname = 'bathy_meter.nc' ! meter bathymetry 419 INQUIRE( FILE=clname, EXIST=llbon ) 420 IF( llbon ) THEN 421 IF(lwp) WRITE(numout,*) 422 IF(lwp) WRITE(numout,*) ' read meter bathymetry in ', clname 423 IF(lwp) WRITE(numout,*) 424 itime = 1 425 ipi = jpidta 426 ipj = jpjdta 427 ipk = 1 428 zdt = rdt 429 CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., & 430 ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 431 CALL flinget( inum, 'Bathymetry', jpidta, jpjdta, 1, & 432 itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 433 CALL flinclo( inum ) 434 ELSE 391 392 clname = 'bathy_level.nc' ! Level bathymetry 393 #if defined key_AGRIF 394 if ( .NOT. Agrif_Root() ) then 395 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 396 endif 397 #endif 398 INQUIRE( FILE=clname, EXIST=llbon ) 399 IF( llbon ) THEN 400 IF(lwp) WRITE(numout,*) 401 IF(lwp) WRITE(numout,*) ' read level bathymetry in ', clname 402 IF(lwp) WRITE(numout,*) 403 itime = 1 404 ipi = jpidta 405 ipj = jpjdta 406 ipk = 1 407 zdt = rdt 408 CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., & 409 ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 410 CALL flinget( inum, 'Bathy_level', jpidta, jpjdta, 1, & 411 itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 412 idta(:,:) = zdta(:,:) 413 CALL flinclo( inum ) 414 415 ELSE 416 IF(lwp) WRITE(numout,cform_err) 417 IF(lwp) WRITE(numout,*)' zgr_bat : unable to read the file', clname 418 nstop = nstop + 1 419 ENDIF 420 421 clname = 'bathy_meter.nc' ! meter bathymetry 422 #if defined key_AGRIF 423 if ( .NOT. Agrif_Root() ) then 424 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 425 endif 426 #endif 427 INQUIRE( FILE=clname, EXIST=llbon ) 428 IF( llbon ) THEN 429 IF(lwp) WRITE(numout,*) 430 IF(lwp) WRITE(numout,*) ' read meter bathymetry in ', clname 431 IF(lwp) WRITE(numout,*) 432 itime = 1 433 ipi = jpidta 434 ipj = jpjdta 435 ipk = 1 436 zdt = rdt 437 CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., & 438 ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 439 CALL flinget( inum, 'Bathymetry', jpidta, jpjdta, 1, & 440 itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 441 CALL flinclo( inum ) 442 ELSE 443 IF( lk_zps .OR. lk_sco ) THEN 435 444 IF(lwp) WRITE(numout,cform_err) 436 445 IF(lwp) WRITE(numout,*)' zgr_bat : unable to read the file', clname 437 446 nstop = nstop + 1 447 ELSE 448 zdta(:,:) = 0.e0 449 IF(lwp) WRITE(numout,*)' zgr_bat : bathy_meter not found, but not used, bathy array set to zero' 438 450 ENDIF 439 451 ENDIF … … 593 605 IF( .NOT. lk_cfg_1d ) THEN 594 606 595 ! Suppress isolated ocean grid points 596 607 ! Suppress isolated ocean grid points 608 609 IF(lwp) WRITE(numout,*) 610 IF(lwp) WRITE(numout,*)' suppress isolated ocean grid points' 611 IF(lwp) WRITE(numout,*)' -----------------------------------' 612 613 icompt = 0 614 615 DO jl = 1, 2 616 617 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 618 mbathy( 1 ,:) = mbathy(jpim1,:) 619 mbathy(jpi,:) = mbathy( 2 ,:) 620 ENDIF 621 DO jj = 2, jpjm1 622 DO ji = 2, jpim1 623 ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj), & 624 mbathy(ji,jj-1),mbathy(ji,jj+1) ) 625 IF( ibtest < mbathy(ji,jj) ) THEN 626 IF(lwp) WRITE(numout,*) ' the number of ocean level at ', & 627 'grid-point (i,j) = ',ji,jj,' is changed from ', & 628 mbathy(ji,jj),' to ', ibtest 629 mbathy(ji,jj) = ibtest 630 icompt = icompt + 1 631 ENDIF 632 END DO 633 END DO 634 635 END DO 636 IF( icompt == 0 ) THEN 637 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' 638 ELSE 639 IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 640 ENDIF 641 IF( lk_mpp ) THEN 642 zbathy(:,:) = FLOAT( mbathy(:,:) ) 643 CALL lbc_lnk( zbathy, 'T', 1. ) 644 mbathy(:,:) = INT( zbathy(:,:) ) 645 ENDIF 646 647 ! 3.2 East-west cyclic boundary conditions 648 649 IF( nperio == 0 ) THEN 650 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west', & 651 ' boundary: nperio = ', nperio 652 IF( lk_mpp ) THEN 653 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 654 IF( jperio /= 1 ) mbathy(1,:) = 0 655 ENDIF 656 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 657 IF( jperio /= 1 ) mbathy(nlci,:) = 0 658 ENDIF 659 ELSE 660 mbathy( 1 ,:) = 0 661 mbathy(jpi,:) = 0 662 ENDIF 663 ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 664 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions', & 665 ' on mbathy: nperio = ', nperio 666 mbathy( 1 ,:) = mbathy(jpim1,:) 667 mbathy(jpi,:) = mbathy( 2 ,:) 668 ELSEIF( nperio == 2 ) THEN 669 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions', & 670 ' on mbathy: nperio = ', nperio 671 ELSE 672 IF(lwp) WRITE(numout,*) ' e r r o r' 673 IF(lwp) WRITE(numout,*) ' parameter , nperio = ', nperio 674 ! STOP 'dom_mba' 675 ENDIF 676 677 ! Set to zero mbathy over islands if necessary (lk_isl=F) 678 IF( .NOT. lk_isl ) THEN ! No island 597 679 IF(lwp) WRITE(numout,*) 598 IF(lwp) WRITE(numout,*)' suppress isolated ocean grid points' 599 IF(lwp) WRITE(numout,*)' -----------------------------------' 600 601 icompt = 0 602 603 DO jl = 1, 2 604 605 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 606 mbathy( 1 ,:) = mbathy(jpim1,:) 607 mbathy(jpi,:) = mbathy( 2 ,:) 608 ENDIF 609 DO jj = 2, jpjm1 610 DO ji = 2, jpim1 611 ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj), & 612 mbathy(ji,jj-1),mbathy(ji,jj+1) ) 613 IF( ibtest < mbathy(ji,jj) ) THEN 614 IF(lwp) WRITE(numout,*) ' the number of ocean level at ', & 615 'grid-point (i,j) = ',ji,jj,' is changed from ', & 616 mbathy(ji,jj),' to ', ibtest 617 mbathy(ji,jj) = ibtest 618 icompt = icompt + 1 619 ENDIF 620 END DO 621 END DO 622 623 END DO 624 IF( icompt == 0 ) THEN 625 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' 626 ELSE 627 IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 628 ENDIF 629 IF( lk_mpp ) THEN 630 zbathy(:,:) = FLOAT( mbathy(:,:) ) 680 IF(lwp) WRITE(numout,*) ' mbathy set to 0 over islands' 681 IF(lwp) WRITE(numout,*) ' ----------------------------' 682 683 mbathy(:,:) = MAX( 0, mbathy(:,:) ) 684 685 ! Boundary condition on mbathy 686 IF( .NOT.lk_mpp ) THEN 687 688 !!bug ??? y reflechir! 689 ! ... mono- or macro-tasking: T-point, >0, 2D array, no slab 690 691 zbathy(:,:) = FLOAT( mbathy(:,:) ) 631 692 CALL lbc_lnk( zbathy, 'T', 1. ) 632 693 mbathy(:,:) = INT( zbathy(:,:) ) 633 694 ENDIF 634 695 635 ! 3.2 East-west cyclic boundary conditions 636 637 IF( nperio == 0 ) THEN 638 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west', & 639 ' boundary: nperio = ', nperio 640 IF( lk_mpp ) THEN 641 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 642 IF( jperio /= 1 ) mbathy(1,:) = 0 643 ENDIF 644 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 645 IF( jperio /= 1 ) mbathy(nlci,:) = 0 646 ENDIF 647 ELSE 648 mbathy( 1 ,:) = 0 649 mbathy(jpi,:) = 0 650 ENDIF 651 ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 652 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions', & 653 ' on mbathy: nperio = ', nperio 654 mbathy( 1 ,:) = mbathy(jpim1,:) 655 mbathy(jpi,:) = mbathy( 2 ,:) 656 ELSEIF( nperio == 2 ) THEN 657 IF(lwp) WRITE(numout,*) ' equatorial boundary conditions', & 658 ' on mbathy: nperio = ', nperio 659 ELSE 660 IF(lwp) WRITE(numout,*) ' e r r o r' 661 IF(lwp) WRITE(numout,*) ' parameter , nperio = ', nperio 662 ! STOP 'dom_mba' 663 ENDIF 664 665 ! Set to zero mbathy over islands if necessary (lk_isl=F) 666 IF( .NOT. lk_isl ) THEN ! No island 667 IF(lwp) WRITE(numout,*) 668 IF(lwp) WRITE(numout,*) ' mbathy set to 0 over islands' 669 IF(lwp) WRITE(numout,*) ' ----------------------------' 670 671 mbathy(:,:) = MAX( 0, mbathy(:,:) ) 672 673 ! Boundary condition on mbathy 674 IF( .NOT.lk_mpp ) THEN 675 !!bug ??? y reflechir! 676 ! ... mono- or macro-tasking: T-point, >0, 2D array, no slab 677 zbathy(:,:) = FLOAT( mbathy(:,:) ) 678 CALL lbc_lnk( zbathy, 'T', 1. ) 679 mbathy(:,:) = INT( zbathy(:,:) ) 680 ENDIF 681 682 ENDIF 696 ENDIF 683 697 684 698 ENDIF -
trunk/NEMO/OPA_SRC/DOM/domzgr_zps.h90
r253 r389 397 397 IF(lwp) THEN 398 398 WRITE(numout,*) ' e3t lev 21 ' 399 CALL prihre(e3t_ps( 1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)399 CALL prihre(e3t_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 400 400 WRITE(numout,*) ' e3w lev 21 ' 401 CALL prihre(e3w_ps( 1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)401 CALL prihre(e3w_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 402 402 WRITE(numout,*) ' e3u lev 21 ' 403 CALL prihre(e3u_ps( 1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)403 CALL prihre(e3u_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 404 404 WRITE(numout,*) ' e3v lev 21 ' 405 CALL prihre(e3v_ps( 1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)405 CALL prihre(e3v_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 406 406 WRITE(numout,*) ' e3f lev 21 ' 407 CALL prihre(e3f_ps( 1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)407 CALL prihre(e3f_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 408 408 WRITE(numout,*) ' e3t lev 22 ' 409 CALL prihre(e3t_ps( 1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)409 CALL prihre(e3t_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 410 410 WRITE(numout,*) ' e3w lev 22 ' 411 CALL prihre(e3w_ps( 1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)411 CALL prihre(e3w_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 412 412 WRITE(numout,*) ' e3u lev 22 ' 413 CALL prihre(e3u_ps( 1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)413 CALL prihre(e3u_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 414 414 WRITE(numout,*) ' e3v lev 22 ' 415 CALL prihre(e3v_ps( 1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)415 CALL prihre(e3v_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 416 416 WRITE(numout,*) ' e3f lev 22 ' 417 CALL prihre(e3f_ps( 1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)417 CALL prihre(e3f_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 418 418 ENDIF 419 419
Note: See TracChangeset
for help on using the changeset viewer.
