Changeset 473 for trunk/NEMO/OPA_SRC/DOM
- Timestamp:
- 2006-05-11T17:04:37+02:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DOM
- Files:
-
- 2 edited
-
domhgr.F90 (modified) (8 diffs)
-
domzgr.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/domhgr.F90
r434 r473 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 !! History : ! 88-03 (G. Madec) 7 !! ! 91-11 (G. Madec) 8 !! ! 92-06 (M. Imbard) 9 !! ! 96-01 (G. Madec) terrain following coordinates 10 !! ! 97-02 (G. Madec) print mesh informations 11 !! ! 99-11 (M. Imbard) NetCDF format with IO-IPSL 12 !! ! 00-08 (D. Ludicone) Reduced section at Bab el Mandeb 13 !! ! 01-09 (M. Levy) eel config: grid in km, beta-plane 14 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module, namelist 15 !! 9.0 ! 04-01 (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh) 16 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 17 !! ! 04-05 (A. Koch-Larrouy) Add Gyre configuration 18 !!---------------------------------------------------------------------- 6 19 7 20 !!---------------------------------------------------------------------- … … 27 40 !! OPA 9.0 , LOCEAN-IPSL (2005) 28 41 !! $Header$ 29 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 30 43 !!---------------------------------------------------------------------- 31 44 … … 84 97 !! define ff: coriolis factor at f-point 85 98 !! 86 !! References : 87 !! Marti, Madec and Delecluse, 1992, j. geophys. res., in press. 88 !! 89 !! History : 90 !! ! 88-03 (G. Madec) 91 !! ! 91-11 (G. Madec) 92 !! ! 92-06 (M. Imbard) 93 !! ! 96-01 (G. Madec) terrain following coordinates 94 !! ! 97-02 (G. Madec) print mesh informations 95 !! ! 01-09 (M. Levy) eel config: grid in km, beta-plane 96 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module, namelist 97 !! 9.0 ! 04-01 (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh) 98 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 99 !! ! 04-05 (A. Koch-Larrouy) Add Gyre configuration 99 !! References : Marti, Madec and Delecluse, 1992, JGR 100 !! Madec, Imbard, 1996, Clim. Dyn. 100 101 !!---------------------------------------------------------------------- 101 !! * local declarations102 102 INTEGER :: ji, jj ! dummy loop indices 103 103 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers … … 164 164 IF(lwp) WRITE(numout,*) 165 165 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e2u at the Gibraltar Strait' 166 ! 167 ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u = 10 km) 168 ij0 = 343 ; ij1 = 343 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e3 169 IF(lwp) WRITE(numout,*) 170 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e2u at the Bosphore Strait' 171 ! 172 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u = 40 km) 173 ij0 = 232 ; ij1 = 232 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 40.e3 174 IF(lwp) WRITE(numout,*) 175 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e2u at the Sumba Strait' 176 ! 177 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u = 15 km) 178 ij0 = 232 ; ij1 = 232 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 15.e3 179 IF(lwp) WRITE(numout,*) 180 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e2u at the Ombai Strait' 181 ! 182 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u = 10 km) 183 ij0 = 270 ; ij1 = 270 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e3 184 IF(lwp) WRITE(numout,*) 185 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e2u at the Palk Strait' 186 ! 187 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v = 10 km) 188 ij0 = 232 ; ij1 = 233 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e3 189 IF(lwp) WRITE(numout,*) 190 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e1v at the Lombok Strait' 191 ! 192 ! 193 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v = 25 km) 194 ij0 = 276 ; ij1 = 276 ; e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 25.e3 195 IF(lwp) WRITE(numout,*) 196 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e1v at the Bab el Mandeb' 166 197 ! 167 198 ENDIF … … 269 300 IF(lwp) WRITE(numout,*) ' geographical mesh on the sphere, MERCATOR type' 270 301 IF(lwp) WRITE(numout,*) ' longitudinal/latitudinal spacing given by ppe1_deg' 271 IF ( ppgphi0 == -90 ) THEN 272 IF(lwp) WRITE(numout,*) ' Mercator grid cannot start at south pole !!!! ' 273 IF(lwp) WRITE(numout,*) ' We stop ' 274 STOP 275 ENDIF 302 IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 276 303 277 304 ! Find index corresponding to the equator, given the grid spacing e1_deg … … 368 395 369 396 CASE DEFAULT 370 IF(lwp) WRITE(numout,cform_err) 371 IF(lwp) WRITE(numout,*) ' bad flag value for jphgr_msh = ', jphgr_msh 372 nstop = nstop + 1 397 WRITE(ctmp1,*) ' bad flag value for jphgr_msh = ', jphgr_msh 398 CALL ctl_stop( ctmp1 ) 373 399 374 400 END SELECT … … 480 506 IF( nperio == 2 ) THEN 481 507 znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi ) 482 IF( znorme > 1.e-13 ) THEN 483 IF(lwp) WRITE(numout,cform_err) 484 IF(lwp) WRITE(numout,*) ' ===>>>> : symmetrical condition: rerun with good equator line' 485 nstop = nstop + 1 486 ENDIF 508 IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 487 509 ENDIF 488 510 … … 499 521 !! or semi-analytical method. It is read in a NetCDF file. 500 522 !! 501 !! References :502 !! Marti, Madec and Delecluse, 1992, JGR, 97, 12,763-12,766.503 !! Madec, Imbard, 1996, Clim. Dyn., 12, 381-388.504 !!505 !! History :506 !! ! (O. Marti) Original code507 !! ! 91-03 (G. Madec)508 !! ! 92-07 (M. Imbard)509 !! ! 99-11 (M. Imbard) NetCDF format with IOIPSL510 !! ! 00-08 (D. Ludicone) Reduced section at Bab el Mandeb511 !! 8.5 ! 02-06 (G. Madec) F90: Free form512 523 !!---------------------------------------------------------------------- 513 !! * Modules used 514 USE ioipsl 515 516 !! * Local declarations 517 LOGICAL :: llog = .FALSE. 518 CHARACTER(len=21) :: clname 519 INTEGER :: ji, jj ! dummy loop indices 520 INTEGER :: inum ! temporary logical unit 521 INTEGER :: ilev, itime ! temporary integers 522 REAL(wp) :: zdt, zdate0 ! temporary scalars 523 REAL(wp) :: zdept(1) ! temporary workspace 524 REAL(wp), DIMENSION(jpidta,jpjdta) :: & 525 zlamt, zphit, zdta ! temporary workspace (NetCDF read) 524 USE iom 525 526 INTEGER :: inum ! temporary logical unit 526 527 !!---------------------------------------------------------------------- 527 clname = 'coordinates'528 #if defined key_agrif529 if ( .NOT. Agrif_Root() ) then530 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)531 endif532 #endif533 534 535 ! 1. Read of the grid coordinates and scale factors536 ! -------------------------------------------------537 528 538 529 IF(lwp) THEN 539 530 WRITE(numout,*) 540 531 WRITE(numout,*) 'hgr_read : read the horizontal coordinates' 541 WRITE(numout,*) '~~~~~~~~ ~~~jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk532 WRITE(numout,*) '~~~~~~~~ jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 542 533 ENDIF 543 544 ! read the file 545 itime = 0 546 ilev = 1 547 zlamt(:,:) = 0.e0 548 zphit(:,:) = 0.e0 549 CALL restini( clname, jpidta, jpjdta, zlamt , zphit, & 550 & ilev , zdept , 'NONE', & 551 & itime , zdate0, zdt , inum, domain_id=nidom ) 552 553 CALL restget( inum, 'glamt', jpidta, jpjdta, 1, itime, llog, zdta ) 554 DO jj = 1, nlcj 555 DO ji = 1, nlci 556 glamt(ji,jj) = zdta(mig(ji),mjg(jj)) 557 END DO 558 END DO 559 CALL restget( inum, 'glamu', jpidta, jpjdta, 1, itime, llog, zdta ) 560 DO jj = 1, nlcj 561 DO ji = 1, nlci 562 glamu(ji,jj) = zdta(mig(ji),mjg(jj)) 563 END DO 564 END DO 565 CALL restget( inum, 'glamv', jpidta, jpjdta, 1, itime, llog, zdta ) 566 DO jj = 1, nlcj 567 DO ji = 1, nlci 568 glamv(ji,jj) = zdta(mig(ji),mjg(jj)) 569 END DO 570 END DO 571 CALL restget( inum, 'glamf', jpidta, jpjdta, 1, itime, llog, zdta ) 572 DO jj = 1, nlcj 573 DO ji = 1, nlci 574 glamf(ji,jj) = zdta(mig(ji),mjg(jj)) 575 END DO 576 END DO 577 CALL restget( inum, 'gphit', jpidta, jpjdta, 1, itime, llog, zdta ) 578 DO jj = 1, nlcj 579 DO ji = 1, nlci 580 gphit(ji,jj) = zdta(mig(ji),mjg(jj)) 581 END DO 582 END DO 583 CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, itime, llog, zdta ) 584 DO jj = 1, nlcj 585 DO ji = 1, nlci 586 gphiu(ji,jj) = zdta(mig(ji),mjg(jj)) 587 END DO 588 END DO 589 CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, itime, llog, zdta ) 590 DO jj = 1, nlcj 591 DO ji = 1, nlci 592 gphiv(ji,jj) = zdta(mig(ji),mjg(jj)) 593 END DO 594 END DO 595 CALL restget( inum, 'gphif', jpidta, jpjdta, 1, itime, llog, zdta ) 596 DO jj = 1, nlcj 597 DO ji = 1, nlci 598 gphif(ji,jj) = zdta(mig(ji),mjg(jj)) 599 END DO 600 END DO 601 CALL restget( inum, 'e1t', jpidta, jpjdta, 1, itime, llog, zdta ) 602 DO jj = 1, nlcj 603 DO ji = 1, nlci 604 e1t (ji,jj) = zdta(mig(ji),mjg(jj)) 605 END DO 606 END DO 607 CALL restget( inum, 'e1u', jpidta, jpjdta, 1, itime, llog, zdta ) 608 DO jj = 1, nlcj 609 DO ji = 1, nlci 610 e1u (ji,jj) = zdta(mig(ji),mjg(jj)) 611 END DO 612 END DO 613 CALL restget( inum, 'e1v', jpidta, jpjdta, 1, itime, llog, zdta ) 614 DO jj = 1, nlcj 615 DO ji = 1, nlci 616 e1v (ji,jj) = zdta(mig(ji),mjg(jj)) 617 END DO 618 END DO 619 CALL restget( inum, 'e1f', jpidta, jpjdta, 1, itime, llog, zdta ) 620 DO jj = 1, nlcj 621 DO ji = 1, nlci 622 e1f (ji,jj) = zdta(mig(ji),mjg(jj)) 623 END DO 624 END DO 625 CALL restget( inum, 'e2t', jpidta, jpjdta, 1, itime, llog, zdta ) 626 DO jj = 1, nlcj 627 DO ji = 1, nlci 628 e2t (ji,jj) = zdta(mig(ji),mjg(jj)) 629 END DO 630 END DO 631 CALL restget( inum, 'e2u', jpidta, jpjdta, 1, itime, llog, zdta ) 632 DO jj = 1, nlcj 633 DO ji = 1, nlci 634 e2u (ji,jj) = zdta(mig(ji),mjg(jj)) 635 END DO 636 END DO 637 CALL restget( inum, 'e2v', jpidta, jpjdta, 1, itime, llog, zdta ) 638 DO jj = 1, nlcj 639 DO ji = 1, nlci 640 e2v (ji,jj) = zdta(mig(ji),mjg(jj)) 641 END DO 642 END DO 643 CALL restget( inum, 'e2f', jpidta, jpjdta, 1, itime, llog, zdta ) 644 DO jj = 1, nlcj 645 DO ji = 1, nlci 646 e2f (ji,jj) = zdta(mig(ji),mjg(jj)) 647 END DO 648 END DO 649 650 CALL restclo( inum ) 651 652 ! set extra rows add in mpp to none zero values 653 DO jj = nlcj+1, jpj 654 DO ji = 1, nlci 655 glamt(ji,jj) = glamt(ji,1) ; gphit(ji,jj) = gphit(ji,1) 656 glamu(ji,jj) = glamu(ji,1) ; gphiu(ji,jj) = gphiu(ji,1) 657 glamv(ji,jj) = glamv(ji,1) ; gphiv(ji,jj) = gphiv(ji,1) 658 glamf(ji,jj) = glamf(ji,1) ; gphif(ji,jj) = gphif(ji,1) 659 e1t (ji,jj) = e1t (ji,1) ; e2t (ji,jj) = e2t (ji,1) 660 e1u (ji,jj) = e1u (ji,1) ; e2u (ji,jj) = e2u (ji,1) 661 e1v (ji,jj) = e1v (ji,1) ; e2v (ji,jj) = e2v (ji,1) 662 e1f (ji,jj) = e1f (ji,1) ; e2f (ji,jj) = e2f (ji,1) 663 END DO 664 END DO 665 666 ! set extra columns add in mpp to none zero values 667 DO ji = nlci+1, jpi 668 glamt(ji,:) = glamt(1,:) ; gphit(ji,:) = gphit(1,:) 669 glamu(ji,:) = glamu(1,:) ; gphiu(ji,:) = gphiu(1,:) 670 glamv(ji,:) = glamv(1,:) ; gphiv(ji,:) = gphiv(1,:) 671 glamf(ji,:) = glamf(1,:) ; gphif(ji,:) = gphif(1,:) 672 e1t (ji,:) = e1t (1,:) ; e2t (ji,:) = e2t (1,:) 673 e1u (ji,:) = e1u (1,:) ; e2u (ji,:) = e2u (1,:) 674 e1v (ji,:) = e1v (1,:) ; e2v (ji,:) = e2v (1,:) 675 e1f (ji,:) = e1f (1,:) ; e2f (ji,:) = e2f (1,:) 676 END DO 677 678 END SUBROUTINE hgr_read 679 534 535 CALL iom_open( 'coordinates', inum ) 536 537 CALL iom_get( inum, jpdom_data, 'glamt', glamt ) 538 CALL iom_get( inum, jpdom_data, 'glamu', glamu ) 539 CALL iom_get( inum, jpdom_data, 'glamv', glamv ) 540 CALL iom_get( inum, jpdom_data, 'glamf', glamf ) 541 542 CALL iom_get( inum, jpdom_data, 'gphit', gphit ) 543 CALL iom_get( inum, jpdom_data, 'gphiu', gphiu ) 544 CALL iom_get( inum, jpdom_data, 'gphiv', gphiv ) 545 CALL iom_get( inum, jpdom_data, 'gphif', gphif ) 546 547 CALL iom_get( inum, jpdom_data, 'e1t', e1t ) 548 CALL iom_get( inum, jpdom_data, 'e1u', e1u ) 549 CALL iom_get( inum, jpdom_data, 'e1v', e1v ) 550 CALL iom_get( inum, jpdom_data, 'e1f', e1f ) 551 552 CALL iom_get( inum, jpdom_data, 'e2t', e2t ) 553 CALL iom_get( inum, jpdom_data, 'e2u', e2u ) 554 CALL iom_get( inum, jpdom_data, 'e2v', e2v ) 555 CALL iom_get( inum, jpdom_data, 'e2f', e2f ) 556 557 CALL iom_close( inum ) 558 559 END SUBROUTINE hgr_read 560 680 561 !!====================================================================== 681 562 END MODULE domhgr -
trunk/NEMO/OPA_SRC/DOM/domzgr.F90
r454 r473 93 93 IF( ln_zps ) ioptio = ioptio + 1 94 94 IF( ln_sco ) ioptio = ioptio + 1 95 IF ( ioptio /= 1 ) THEN 96 IF(lwp) WRITE(numout,cform_err) 97 IF(lwp) WRITE(numout,*) ' none or several vertical coordinate options used' 98 nstop = nstop + 1 99 ENDIF 95 IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 100 96 101 97 IF( ln_zco ) THEN 102 98 IF(lwp) WRITE(numout,*) ' z-coordinate with reduced incore memory requirement' 103 IF( ln_zps .OR. ln_sco ) THEN 104 IF(lwp) WRITE(numout,cform_err) 105 IF(lwp) WRITE(numout,*) ' reduced memory with zps or sco option is impossible' 106 nstop = nstop + 1 107 ENDIF 99 IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' ) 108 100 ENDIF 109 101 … … 264 256 265 257 DO jk = 1, jpk 266 IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) THEN 267 IF(lwp) WRITE(numout,cform_err) 268 IF(lwp) WRITE(numout,*) ' e3w or e3t =< 0 ' 269 nstop = nstop + 1 270 ENDIF 271 IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.) THEN 272 IF(lwp) WRITE(numout,cform_err) 273 IF(lwp) WRITE(numout,*) ' gdepw or gdept < 0 ' 274 nstop = nstop + 1 275 ENDIF 258 IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop( ' e3w or e3t =< 0 ' ) 259 IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0. ) CALL ctl_stop( ' gdepw or gdept < 0 ' ) 276 260 END DO 277 261 … … 318 302 !!---------------------------------------------------------------------- 319 303 !! * Modules used 320 USE io ipsl304 USE iom 321 305 322 306 !! * Local declarations 323 CHARACTER (len=18) :: clname ! temporary characters324 LOGICAL :: llbon ! check the existence of bathy files325 307 INTEGER :: ji, jj, jl, jk ! dummy loop indices 326 INTEGER :: inum = 11! temporary logical unit308 INTEGER :: inum ! temporary logical unit 327 309 INTEGER :: & 328 ipi, ipj, ipk, & ! temporary integers 329 itime, ih, & ! " " 330 ii_bump, ij_bump ! bump center position 331 INTEGER, DIMENSION (1) :: istep 310 ii_bump, ij_bump, ih ! bump center position 332 311 INTEGER , DIMENSION(jpidta,jpjdta) :: & 333 312 idta ! global domain integer data 334 313 REAL(wp) :: & 335 314 r_bump, h_bump, h_oce, & ! bump characteristics 336 zi, zj, z date0, zdt, zh! temporary scalars315 zi, zj, zh ! temporary scalars 337 316 REAL(wp), DIMENSION(jpidta,jpjdta) :: & 338 zlamt, zphit, & ! 2D workspace (NetCDF read)339 317 zdta ! global domain scalar data 340 REAL(wp), DIMENSION(jpk) :: &341 zdept ! 1D workspace (NetCDF read)342 318 !!---------------------------------------------------------------------- 343 319 … … 427 403 ENDIF 428 404 405 ! ======================================= 406 ! local domain level and meter bathymetry (mbathy,bathy) 407 ! ======================================= 408 409 mbathy(:,:) = 0 ! set to zero extra halo points 410 bathy (:,:) = 0.e0 ! (require for mpp case) 411 412 DO jj = 1, nlcj ! interior values 413 DO ji = 1, nlci 414 mbathy(ji,jj) = idta( mig(ji), mjg(jj) ) 415 bathy (ji,jj) = zdta( mig(ji), mjg(jj) ) 416 END DO 417 END DO 418 429 419 ! ! =============== ! 430 420 ELSEIF( ntopo == 1 ) THEN ! read in file ! 431 421 ! ! =============== ! 432 422 433 clname = 'bathy_level.nc' ! Level bathymetry 434 #if defined key_agrif 435 IF( .NOT. Agrif_Root() ) THEN 436 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 437 ENDIF 438 #endif 439 INQUIRE( FILE=clname, EXIST=llbon ) 440 IF( llbon ) THEN 441 IF(lwp) WRITE(numout,*) 442 IF(lwp) WRITE(numout,*) ' read level bathymetry in ', clname 443 IF(lwp) WRITE(numout,*) 444 ipi = jpidta ; ipj = jpjdta 445 ipk = 1 ; itime = 1 ; zdt = rdt 446 CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., & 447 & ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 448 CALL flinget( inum, 'Bathy_level', jpidta, jpjdta, 1, & 449 & itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 450 CALL flinclo( inum ) 451 idta(:,:) = zdta(:,:) 452 ELSE 423 CALL iom_open ( 'bathy_level.nc', inum ) ! Level bathymetry 424 IF ( inum > 0 ) THEN 425 CALL iom_get ( inum, jpdom_data, 'Bathy_level', bathy ) 426 CALL iom_close (inum) 427 mbathy(:,:) = INT( bathy(:,:) ) 428 ELSE 453 429 IF( ln_zco ) THEN 454 IF(lwp) WRITE(numout,cform_err) 455 IF(lwp) WRITE(numout,*)' zgr_bat : unable to read the file ', clname 456 nstop = nstop + 1 430 CALL ctl_stop( ' zgr_bat : unable to read the file ' ) 457 431 ELSE 458 432 IF(lwp) WRITE(numout,*)' zgr_bat : bathy_level will be computed from bathy_meter' 459 idta(:,:) = jpkm1 ! initialisation 433 nstop = nstop - 1 ! supress the error count for opening 'bathy_level.nc' 434 mbathy(:,:) = jpkm1 460 435 ENDIF 461 436 ENDIF 462 437 463 clname = 'bathy_meter.nc' ! meter bathymetry 464 #if defined key_agrif 465 IF( .NOT. Agrif_Root() ) THEN 466 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 467 ENDIF 468 #endif 469 INQUIRE( FILE=clname, EXIST=llbon ) 470 IF( llbon ) THEN 471 IF(lwp) WRITE(numout,*) 472 IF(lwp) WRITE(numout,*) ' read meter bathymetry in ', clname 473 IF(lwp) WRITE(numout,*) 474 ipi = jpidta ; ipj = jpjdta 475 ipk = 1 ; itime = 1 ; zdt = rdt 476 CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., & 477 & ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 478 CALL flinget( inum, 'Bathymetry', jpidta, jpjdta, 1, & 479 & itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 480 CALL flinclo( inum ) 481 ELSE 438 CALL iom_open ( 'bathy_meter.nc', inum ) ! meter bathymetry 439 IF ( inum > 0 ) THEN 440 CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy ) 441 CALL iom_close (inum) 442 ELSE 482 443 IF( ln_zps .OR. ln_sco ) THEN 483 IF(lwp) WRITE(numout,cform_err) 484 IF(lwp) WRITE(numout,*)' zgr_bat : unable to read the file', clname 485 nstop = nstop + 1 444 CALL ctl_stop( ' zgr_bat : unable to read the file ' ) 486 445 ELSE 487 zdta(:,:) = 0.e0 446 bathy(:,:) = 0.e0 ! initialisation 447 nstop = nstop - 1 ! supress the error count for opening 'bathy_level.nc' 488 448 IF(lwp) WRITE(numout,*)' zgr_bat : bathy_meter not found, but not used, bathy array set to zero' 489 449 ENDIF … … 492 452 ELSE ! error ! 493 453 ! ! =============== ! 494 IF(lwp) WRITE(numout,cform_err) 495 IF(lwp) WRITE(numout,*) ' parameter , ntopo = ', ntopo 496 nstop = nstop + 1 497 ENDIF 498 499 500 ! ======================================= 501 ! local domain level and meter bathymetry (mbathy,bathy) 502 ! ======================================= 503 504 mbathy(:,:) = 0 ! set to zero extra halo points 505 bathy (:,:) = 0.e0 ! (require for mpp case) 506 507 DO jj = 1, nlcj ! interior values 508 DO ji = 1, nlci 509 mbathy(ji,jj) = idta( mig(ji), mjg(jj) ) 510 bathy (ji,jj) = zdta( mig(ji), mjg(jj) ) 511 END DO 512 END DO 513 514 write(numout,*) ' MIN val mbathy 2 ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 515 454 WRITE(ctmp1,*) ' parameter , ntopo = ', ntopo 455 CALL ctl_stop( ' zgr_bat : '//trim(ctmp1) ) 456 ENDIF 516 457 517 458 ! ======================= … … 531 472 ENDIF 532 473 474 #if defined key_orca_lev10 475 ! 10 time the vertical resolution 476 mbathy(:,:) = 10 * mbathy(:,:) 477 IF(lwp) WRITE(numout,*) ' ATTENTION: 300 niveaux avec bathy levels "vraie?"' 478 #endif 533 479 ! =========== 534 480 ! Zoom domain … … 1221 1167 WRITE(numout,9430) (jk,fsdept(1,1,jk),fsdepw(1,1,jk), & 1222 1168 fse3t (1,1,jk),fse3w (1,1,jk),jk=1,jpk) 1223 WRITE(numout,*) 1224 WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k) bathy = ', bathy(20,20), hbatt(20,20) 1225 WRITE(numout,*) ' ~~~~~~ --------------------' 1226 WRITE(numout,9420) 1227 WRITE(numout,9430) (jk,fsdept(20,20,jk),fsdepw(20,20,jk), & 1228 fse3t (20,20,jk),fse3w (20,20,jk),jk=1,jpk) 1229 WRITE(numout,*) 1230 WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k) bathy = ', bathy(100,74), hbatt(100,74) 1231 WRITE(numout,*) ' ~~~~~~ --------------------' 1232 WRITE(numout,9420) 1233 WRITE(numout,9430) (jk,fsdept(100,74,jk),fsdepw(100,74,jk), & 1234 fse3t (100,74,jk),fse3w (100,74,jk),jk=1,jpk) 1169 DO jj = mj0(20), mj1(20) 1170 DO ji = mi0(20), mi1(20) 1171 WRITE(numout,*) 1172 WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k) bathy = ', bathy(ji,jj), hbatt(ji,jj) 1173 WRITE(numout,*) ' ~~~~~~ --------------------' 1174 WRITE(numout,9420) 1175 WRITE(numout,9430) (jk,fsdept(ji,jj,jk),fsdepw(ji,jj,jk), & 1176 & fse3t (ji,jj,jk),fse3w (ji,jj,jk),jk=1,jpk) 1177 END DO 1178 END DO 1179 DO jj = mj0(74), mj1(74) 1180 DO ji = mi0(100), mi1(100) 1181 WRITE(numout,*) 1182 WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k) bathy = ', bathy(ji,jj), hbatt(ji,jj) 1183 WRITE(numout,*) ' ~~~~~~ --------------------' 1184 WRITE(numout,9420) 1185 WRITE(numout,9430) (jk,fsdept(ji,jj,jk),fsdepw(ji,jj,jk), & 1186 & fse3t (ji,jj,jk),fse3w (ji,jj,jk),jk=1,jpk) 1187 END DO 1188 END DO 1235 1189 ENDIF 1236 1190
Note: See TracChangeset
for help on using the changeset viewer.
