Changeset 473 for trunk/NEMO/OPA_SRC/DOM/domhgr.F90
- Timestamp:
- 2006-05-11T17:04:37+02:00 (18 years ago)
- File:
-
- 1 edited
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
Note: See TracChangeset
for help on using the changeset viewer.