Changeset 389 for trunk/NEMO/OPA_SRC/DOM/domzgr.F90
- Timestamp:
- 2006-03-09T18:22:04+01:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
