Changeset 81 for trunk/NEMO/OPA_SRC/DOM/domhgr.F90
- Timestamp:
- 2004-04-22T15:02:16+02:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/domhgr.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/domhgr.F90
r29 r81 7 7 !!---------------------------------------------------------------------- 8 8 !! dom_hgr : initialize the horizontal mesh 9 !! dom_hgr_coo : read "coordinate" file (except for EEL config.) 9 !! hgr_read : read "coordinate" NetCDF file 10 !! hgr_read_fdir : read "coordinate" direct access file 10 11 !!---------------------------------------------------------------------- 11 12 !! * Modules used … … 43 44 !! the two horizontal directions (fse1 and fse2), the model grid- 44 45 !! point position and scale factors are given by: 45 !! t-point: glamt(i,j) = fslam(i,j) 46 !! gphit(i,j) = fsphi(i,j) 47 !! e1t (i,j) = fse1 (i,j) 48 !! e2t (i,j) = fse2 (i,j) 49 !! u-point: glamu(i,j) = fslam(i+0.5,j) 50 !! gphiu(i,j) = fsphi(i+0.5,j) 51 !! e1u (i,j) = fse1 (i+0.5,j) 52 !! e2u (i,j) = fse2 (i+0.5,j) 53 !! v-point: glamv(i,j) = fslam(i,j+0.5) 54 !! gphiv(i,j) = fsphi(i,j+0.5) 55 !! e1v (i,j) = fse1 (i,j+0.5) 56 !! e2v (i,j) = fse2 (i,j+0.5) 57 !! f-point: glamf(i,j) = fslam(i+0.5,j+0.5) 58 !! gphif(i,j) = fsphi(i+0.5,j+0.5) 59 !! e1f (i,j) = fse1 (i+0.5,j+0.5) 60 !! e2f (i,j) = fse2 (i+0.5,j+0.5) 46 !! t-point: 47 !! glamt(i,j) = fslam(i ,j ) e1t(i,j) = fse1(i ,j ) 48 !! gphit(i,j) = fsphi(i ,j ) e2t(i,j) = fse2(i ,j ) 49 !! u-point: 50 !! glamu(i,j) = fslam(i+1/2,j ) e1u(i,j) = fse1(i+1/2,j ) 51 !! gphiu(i,j) = fsphi(i+1/2,j ) e2u(i,j) = fse2(i+1/2,j ) 52 !! v-point: 53 !! glamv(i,j) = fslam(i ,j+1/2) e1v(i,j) = fse1(i ,j+1/2) 54 !! gphiv(i,j) = fsphi(i ,j+1/2) e2v(i,j) = fse2(i ,j+1/2) 55 !! f-point: 56 !! glamf(i,j) = fslam(i+1/2,j+1/2) e1f(i,j) = fse1(i+1/2,j+1/2) 57 !! gphif(i,j) = fsphi(i+1/2,j+1/2) e2f(i,j) = fse2(i+1/2,j+1/2) 61 58 !! Where fse1 and fse2 are defined by: 62 59 !! fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2 … … 100 97 !!---------------------------------------------------------------------- 101 98 !! * local declarations 102 INTEGER :: ji, jj ! dummy loop indices 103 INTEGER :: ijeq ! index of equator T point (computed for case 4) 99 INTEGER :: ji, jj ! dummy loop indices 100 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 101 INTEGER :: ijeq ! index of equator T point (used in case 4) 104 102 REAL(wp) :: & 105 zti, zui, zvi, zfi, & ! temporary scalars106 ztj, zuj, zvj, zfj, & !107 zphi0, zbeta, znorme, & !103 zti, zui, zvi, zfi, & ! temporary scalars 104 ztj, zuj, zvj, zfj, & ! 105 zphi0, zbeta, znorme, & ! 108 106 zarg, zf0 109 107 !!---------------------------------------------------------------------- … … 127 125 128 126 IF(lwp) WRITE(numout,*) 129 IF(lwp) WRITE(numout,*) ' curvilinear coordinate on the sphere read in coordinate.nc file' 130 131 CALL dom_hgr_coo 127 IF(lwp) WRITE(numout,*) ' curvilinear coordinate on the sphere read in "coordinate" file' 128 #if defined key_fdir 129 CALL hgr_read_fdir ! 'key_fdir' : direct access file 130 #else 131 CALL hgr_read ! Defaultl option : NetCDF file 132 #endif 133 134 ! ! ===================== 135 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 136 ! ! ===================== 137 IF( n_cla == 0 ) THEN 138 ii0 = 160 ; ii1 = 161 ! Bab el Mandeb (e2u = 18 km) 139 ij0 = 88 ; ij1 = 88 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 18.e3 140 IF(lwp) WRITE(numout,*) 141 IF(lwp) WRITE(numout,*) ' orca_r2: Bab el Mandeb: e2u reduced to 18 km' 142 ENDIF 143 144 ii0 = 145 ; ii1 = 146 ! Sound Strait (e2u = 15 km) 145 ij0 = 116 ; ij1 = 116 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 15.e3 146 IF(lwp) WRITE(numout,*) 147 IF(lwp) WRITE(numout,*) ' orca_r2: Reduced e2u at the Sound Strait' 148 ! 149 ENDIF 150 151 ! ! ====================== 152 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration 153 ! ! ====================== 154 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u = 20 km) 155 ij0 = 327 ; ij1 = 327 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 156 IF(lwp) WRITE(numout,*) 157 IF(lwp) WRITE(numout,*) ' orca_r05: Reduced e2u at the Gibraltar Strait' 158 ! 159 ENDIF 160 132 161 133 162 ! N.B. : General case, lat and long function of both i and j indices: … … 267 296 END DO 268 297 269 270 271 298 CASE DEFAULT 272 299 IF(lwp) WRITE(numout,cform_err) … … 352 379 IF( znorme > 1.e-13 ) THEN 353 380 IF(lwp) WRITE(numout,cform_err) 354 IF(lwp) WRITE(numout,*) ' ' 355 IF(lwp) WRITE(numout,*) ' ===>>>> : symmetrical condition' 356 IF(lwp) WRITE(numout,*) 'stop rerun with good equator line' 357 IF(lwp) WRITE(numout,*) ' ----' 381 IF(lwp) WRITE(numout,*) ' ===>>>> : symmetrical condition: rerun with good equator line' 358 382 nstop = nstop + 1 359 383 ENDIF … … 362 386 END SUBROUTINE dom_hgr 363 387 364 #if defined key_fdir 365 !!--------------------------------------------------------------------- 366 !! 'key-fdir direct access file 367 !!--------------------------------------------------------------------- 368 # include "domhgr_coo_fdir.h90" 369 370 #else 371 !!--------------------------------------------------------------------- 372 !! Defaultl option : NetCDF file 373 !!--------------------------------------------------------------------- 374 375 SUBROUTINE dom_hgr_coo 388 389 SUBROUTINE hgr_read 376 390 !!--------------------------------------------------------------------- 377 !! *** ROUTINE dom_hgr_coo***391 !! *** ROUTINE hgr_read *** 378 392 !! 379 393 !! ** Purpose : Read a coordinate file in NetCDF format … … 398 412 399 413 !! * Local declarations 400 LOGICAL :: llog 401 CHARACTER(len=21) :: clname 414 LOGICAL :: llog = .FALSE. 415 CHARACTER(len=21) :: clname = 'coordinates' 402 416 INTEGER :: ji, jj ! dummy loop indices 403 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers404 417 INTEGER :: inum ! temporary logical unit 405 418 INTEGER :: ilev, itime ! temporary integers … … 407 420 REAL(wp) :: zdept(1) ! temporary workspace 408 421 REAL(wp), DIMENSION(jpidta,jpjdta) :: & 409 zlamt, zphit, zdta ! temporary workspace 422 zlamt, zphit, zdta ! temporary workspace (NetCDF read) 410 423 !!---------------------------------------------------------------------- 411 424 … … 416 429 IF(lwp) THEN 417 430 WRITE(numout,*) 418 WRITE(numout,*) 'dom_hgr_coo : read the horizontal coordinates' 419 WRITE(numout,*) '~~~~~~~~~~~' 420 WRITE(numout,*) ' jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk 431 WRITE(numout,*) 'hgr_read : read the horizontal coordinates' 432 WRITE(numout,*) '~~~~~~~~~~~ jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 421 433 ENDIF 422 434 423 435 ! read the file 424 436 itime = 0 425 clname = 'coordinates'426 llog = .FALSE.427 437 ilev = 1 428 438 zlamt(:,:) = 0.e0 429 439 zphit(:,:) = 0.e0 430 CALL restini( clname,jpidta,jpjdta,zlamt,zphit,ilev,zdept,clname & 431 & ,itime,zdate0,zdt,inum) 432 433 CALL restget(inum,'glamt',jpidta,jpjdta,1,0,llog,zdta) 440 CALL restini( clname, jpidta, jpjdta, zlamt , zphit, & 441 & ilev , zdept , clname, & 442 & itime , zdate0, zdt , inum ) 443 444 CALL restget( inum, 'glamt', jpidta, jpjdta, 1, 0, llog, zdta ) 434 445 DO jj = 1, nlcj 435 446 DO ji = 1, nlci … … 437 448 END DO 438 449 END DO 439 CALL restget( inum,'glamu',jpidta,jpjdta,1,0,llog,zdta)450 CALL restget( inum, 'glamu', jpidta, jpjdta, 1, 0, llog, zdta ) 440 451 DO jj = 1, nlcj 441 452 DO ji = 1, nlci … … 443 454 END DO 444 455 END DO 445 CALL restget( inum,'glamv',jpidta,jpjdta,1,0,llog,zdta)456 CALL restget( inum, 'glamv', jpidta, jpjdta, 1, 0, llog, zdta ) 446 457 DO jj = 1, nlcj 447 458 DO ji = 1, nlci … … 449 460 END DO 450 461 END DO 451 CALL restget( inum,'glamf',jpidta,jpjdta,1,0,llog,zdta)462 CALL restget( inum, 'glamf', jpidta, jpjdta, 1, 0, llog, zdta ) 452 463 DO jj = 1, nlcj 453 464 DO ji = 1, nlci … … 455 466 END DO 456 467 END DO 457 CALL restget( inum,'gphit',jpidta,jpjdta,1,0,llog,zdta)468 CALL restget( inum, 'gphit', jpidta, jpjdta, 1, 0, llog, zdta ) 458 469 DO jj = 1, nlcj 459 470 DO ji = 1, nlci … … 461 472 END DO 462 473 END DO 463 CALL restget( inum,'gphiu',jpidta,jpjdta,1,0,llog,zdta)474 CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, 0, llog, zdta ) 464 475 DO jj = 1, nlcj 465 476 DO ji = 1, nlci … … 467 478 END DO 468 479 END DO 469 CALL restget( inum,'gphiv',jpidta,jpjdta,1,0,llog,zdta)480 CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, 0, llog, zdta ) 470 481 DO jj = 1, nlcj 471 482 DO ji = 1, nlci … … 473 484 END DO 474 485 END DO 475 CALL restget( inum,'gphif',jpidta,jpjdta,1,0,llog,zdta)486 CALL restget( inum, 'gphif', jpidta, jpjdta, 1, 0, llog, zdta ) 476 487 DO jj = 1, nlcj 477 488 DO ji = 1, nlci … … 479 490 END DO 480 491 END DO 481 CALL restget( inum,'e1t',jpidta,jpjdta,1,0,llog,zdta)492 CALL restget( inum, 'e1t', jpidta, jpjdta, 1, 0, llog, zdta ) 482 493 DO jj = 1, nlcj 483 494 DO ji = 1, nlci … … 485 496 END DO 486 497 END DO 487 CALL restget( inum,'e1u',jpidta,jpjdta,1,0,llog,zdta)498 CALL restget( inum, 'e1u', jpidta, jpjdta, 1, 0, llog, zdta ) 488 499 DO jj = 1, nlcj 489 500 DO ji = 1, nlci … … 491 502 END DO 492 503 END DO 493 CALL restget( inum,'e1v',jpidta,jpjdta,1,0,llog,zdta)504 CALL restget( inum, 'e1v', jpidta, jpjdta, 1, 0, llog, zdta ) 494 505 DO jj = 1, nlcj 495 506 DO ji = 1, nlci … … 497 508 END DO 498 509 END DO 499 CALL restget( inum,'e1f',jpidta,jpjdta,1,0,llog,zdta)510 CALL restget( inum, 'e1f', jpidta, jpjdta, 1, 0, llog, zdta ) 500 511 DO jj = 1, nlcj 501 512 DO ji = 1, nlci … … 503 514 END DO 504 515 END DO 505 CALL restget( inum,'e2t',jpidta,jpjdta,1,0,llog,zdta)516 CALL restget( inum, 'e2t', jpidta, jpjdta, 1, 0, llog, zdta ) 506 517 DO jj = 1, nlcj 507 518 DO ji = 1, nlci … … 509 520 END DO 510 521 END DO 511 CALL restget( inum,'e2u',jpidta,jpjdta,1,0,llog,zdta)522 CALL restget( inum, 'e2u', jpidta, jpjdta, 1, 0, llog, zdta ) 512 523 DO jj = 1, nlcj 513 524 DO ji = 1, nlci … … 515 526 END DO 516 527 END DO 517 CALL restget( inum,'e2v',jpidta,jpjdta,1,0,llog,zdta)528 CALL restget( inum, 'e2v', jpidta, jpjdta, 1, 0, llog, zdta ) 518 529 DO jj = 1, nlcj 519 530 DO ji = 1, nlci … … 521 532 END DO 522 533 END DO 523 CALL restget( inum,'e2f',jpidta,jpjdta,1,0,llog,zdta)534 CALL restget( inum, 'e2f', jpidta, jpjdta, 1, 0, llog, zdta ) 524 535 DO jj = 1, nlcj 525 536 DO ji = 1, nlci … … 528 539 END DO 529 540 530 CALL restclo( inum)541 CALL restclo( inum ) 531 542 532 543 ! set extra rows add in mpp to none zero values … … 556 567 END DO 557 568 558 ! ! ===================== 559 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 560 ! ! ===================== 561 IF( n_cla == 0 ) THEN 562 ii0 = 160 ; ii1 = 161 ! Bab el Mandeb (e2u = 18 km) 563 ij0 = 88 ; ij1 = 88 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij0) ) = 18.e3 564 IF(lwp) WRITE(numout,*) 565 IF(lwp) WRITE(numout,*) ' Bab el Mandeb: e2u reduced to 18 km' 566 ENDIF 567 568 ii0 = 145 ; ii1 = 146 ! Sound Strait (e2u = 15 km) 569 ij0 = 116 ; ij1 = 116 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij0) ) = 15.e3 570 IF(lwp) WRITE(numout,*) 571 IF(lwp) WRITE(numout,*) ' : Reduced e2u at the Sound Strait' 572 ! 573 ENDIF 574 575 ! ! ====================== 576 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration 577 ! ! ====================== 578 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u = 20 km) 579 ij0 = 327 ; ij1 = 327 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij0) ) = 20.e3 580 IF(lwp) WRITE(numout,*) 581 IF(lwp) WRITE(numout,*) ' : Reduced e2u at the Gibraltar Strait' 582 ! 583 ENDIF 584 585 END SUBROUTINE dom_hgr_coo 586 587 #endif 569 END SUBROUTINE hgr_read 570 571 572 SUBROUTINE hgr_read_fdir 573 !!---------------------------------------------------------------------- 574 !! *** ROUTINE hgr_read_fdir *** 575 !! 576 !!---------------------------------------------------------------------- 577 !! * Local declarations 578 CHARACTER (len=5) :: clfield 579 CHARACTER(len=21) :: clname = 'coordinates' 580 INTEGER :: ji, jj ! dummy loop indices 581 INTEGER :: inumcoo = 11 ! logical unit for coordinate file 582 INTEGER :: ijpi, ijpj ! temporary integers 583 REAL(wp), DIMENSION(jpi,jpj) :: zdta ! temporary workspace 584 !!---------------------------------------------------------------------- 585 586 587 ! 1. Read of the grid coordinates and scale factors 588 ! ------------------------------------------------- 589 590 IF(lwp) THEN 591 WRITE(numout,*) 592 WRITE(numout,*) 'hgrcoo : read the horizontal coordinates' 593 WRITE(numout,*) '~~~~~~' 594 WRITE(numout,*) ' jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk 595 ENDIF 596 597 ! open the file 598 CALL ctlopn( inumcoo, clname, 'OLD', 'UNFORMATTED', 'SEQUENTIAL', & 599 1 , numout , lwp , 1 ) 600 601 ! read the file 602 READ(inumcoo) ijpi,ijpj 603 IF( (ijpi /= jpidta) .OR. (ijpj /= jpjdta) ) THEN 604 IF(lwp) THEN 605 WRITE(numout,*) 606 WRITE(numout,*) ' inconsitency in reading coordinate file, unit=',inumcoo 607 WRITE(numout,*) ' jpidta = ',jpidta ,' jpi read = ',ijpi 608 WRITE(numout,*) ' jpjdta = ',jpjdta ,' jpj read = ',ijpj 609 WRITE(numout,*) 610 ENDIF 611 nstop = nstop + 1 612 ENDIF 613 614 READ(inumcoo) clfield, zdta 615 IF( clfield /= 'GLAMT' ) THEN 616 IF(lwp) THEN 617 WRITE(numout,cform_err) 618 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMT' 619 ENDIF 620 nstop = nstop + 1 621 ENDIF 622 DO jj = 1, nlcj 623 DO ji = 1, nlci 624 glamt(ji,jj) = zdta(mig(ji),mjg(jj)) 625 END DO 626 END DO 627 READ(inumcoo) clfield, zdta 628 IF(clfield /= 'GLAMU') THEN 629 IF(lwp) THEN 630 WRITE(numout,cform_err) 631 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMU' 632 ENDIF 633 nstop = nstop + 1 634 ENDIF 635 DO jj = 1, nlcj 636 DO ji = 1, nlci 637 glamu(ji,jj) = zdta(mig(ji),mjg(jj)) 638 END DO 639 END DO 640 READ(inumcoo) clfield, zdta 641 IF(clfield /= 'GLAMV') THEN 642 IF(lwp) THEN 643 WRITE(numout,cform_err) 644 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMV' 645 ENDIF 646 nstop = nstop + 1 647 ENDIF 648 DO jj = 1, nlcj 649 DO ji = 1, nlci 650 glamv(ji,jj) = zdta(mig(ji),mjg(jj)) 651 END DO 652 END DO 653 READ(inumcoo) clfield, zdta 654 IF(clfield /= 'GLAMF') THEN 655 IF(lwp) THEN 656 WRITE(numout,cform_err) 657 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMF' 658 ENDIF 659 nstop = nstop + 1 660 ENDIF 661 DO jj = 1, nlcj 662 DO ji = 1, nlci 663 glamf(ji,jj) = zdta(mig(ji),mjg(jj)) 664 END DO 665 END DO 666 READ(inumcoo) clfield, zdta 667 IF(clfield /= 'GPHIT') THEN 668 IF(lwp) THEN 669 WRITE(numout,cform_err) 670 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIT' 671 ENDIF 672 nstop = nstop + 1 673 ENDIF 674 DO jj = 1, nlcj 675 DO ji = 1, nlci 676 gphit(ji,jj) = zdta(mig(ji),mjg(jj)) 677 END DO 678 END DO 679 READ(inumcoo) clfield, zdta 680 IF(clfield /= 'GPHIU') THEN 681 IF(lwp) THEN 682 WRITE(numout,cform_err) 683 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIU' 684 ENDIF 685 nstop = nstop + 1 686 ENDIF 687 DO jj = 1, nlcj 688 DO ji = 1, nlci 689 gphiu(ji,jj) = zdta(mig(ji),mjg(jj)) 690 END DO 691 END DO 692 READ(inumcoo) clfield, zdta 693 IF(clfield /= 'GPHIV') THEN 694 IF(lwp) THEN 695 WRITE(numout,cform_err) 696 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIV' 697 ENDIF 698 nstop = nstop + 1 699 ENDIF 700 DO jj = 1, nlcj 701 DO ji = 1, nlci 702 gphiv(ji,jj) = zdta(mig(ji),mjg(jj)) 703 END DO 704 END DO 705 READ(inumcoo) clfield, zdta 706 IF(clfield /= 'GPHIF') THEN 707 IF(lwp) THEN 708 WRITE(numout,cform_err) 709 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIF' 710 ENDIF 711 nstop = nstop + 1 712 ENDIF 713 DO jj = 1, nlcj 714 DO ji = 1, nlci 715 gphif(ji,jj) = zdta(mig(ji),mjg(jj)) 716 END DO 717 END DO 718 READ(inumcoo) clfield, zdta 719 IF(clfield /= 'E1T ') THEN 720 IF(lwp) THEN 721 WRITE(numout,cform_err) 722 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1T ' 723 ENDIF 724 nstop = nstop + 1 725 ENDIF 726 DO jj = 1, nlcj 727 DO ji = 1, nlci 728 e1t (ji,jj) = zdta(mig(ji),mjg(jj)) 729 END DO 730 END DO 731 READ(inumcoo) clfield, zdta 732 IF(clfield /= 'E1U ') THEN 733 IF(lwp) THEN 734 WRITE(numout,cform_err) 735 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1U ' 736 ENDIF 737 nstop = nstop + 1 738 ENDIF 739 DO jj = 1, nlcj 740 DO ji = 1, nlci 741 e1u (ji,jj) = zdta(mig(ji),mjg(jj)) 742 END DO 743 END DO 744 READ(inumcoo) clfield, zdta 745 IF(clfield /= 'E1V ') THEN 746 IF(lwp) THEN 747 WRITE(numout,cform_err) 748 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1V ' 749 ENDIF 750 nstop = nstop + 1 751 ENDIF 752 DO jj = 1, nlcj 753 DO ji = 1, nlci 754 e1v (ji,jj) = zdta(mig(ji),mjg(jj)) 755 END DO 756 END DO 757 READ(inumcoo) clfield, zdta 758 IF(clfield /= 'E1F ') THEN 759 IF(lwp) THEN 760 WRITE(numout,cform_err) 761 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1F ' 762 ENDIF 763 nstop = nstop + 1 764 ENDIF 765 DO jj = 1, nlcj 766 DO ji = 1, nlci 767 e1f (ji,jj) = zdta(mig(ji),mjg(jj)) 768 END DO 769 END DO 770 READ(inumcoo) clfield, zdta 771 IF(clfield /= 'E2T ') THEN 772 IF(lwp) THEN 773 WRITE(numout,cform_err) 774 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2T ' 775 ENDIF 776 nstop = nstop + 1 777 ENDIF 778 DO jj = 1, nlcj 779 DO ji = 1, nlci 780 e2t (ji,jj) = zdta(mig(ji),mjg(jj)) 781 END DO 782 END DO 783 READ(inumcoo) clfield, zdta 784 IF(clfield /= 'E2U ') THEN 785 IF(lwp) THEN 786 WRITE(numout,cform_err) 787 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2U ' 788 ENDIF 789 nstop = nstop + 1 790 ENDIF 791 DO jj = 1, nlcj 792 DO ji = 1, nlci 793 e2u (ji,jj) = zdta(mig(ji),mjg(jj)) 794 END DO 795 END DO 796 READ(inumcoo) clfield, zdta 797 IF(clfield /= 'E2V ') THEN 798 IF(lwp) THEN 799 WRITE(numout,cform_err) 800 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2V ' 801 ENDIF 802 nstop = nstop + 1 803 ENDIF 804 DO jj = 1, nlcj 805 DO ji = 1, nlci 806 e2v (ji,jj) = zdta(mig(ji),mjg(jj)) 807 END DO 808 END DO 809 READ(inumcoo) clfield, zdta 810 IF(clfield /= 'E2F ') THEN 811 IF(lwp) THEN 812 WRITE(numout,cform_err) 813 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2F ' 814 ENDIF 815 nstop = nstop + 1 816 ENDIF 817 DO jj = 1, nlcj 818 DO ji = 1, nlci 819 e2f (ji,jj) = zdta(mig(ji),mjg(jj)) 820 END DO 821 END DO 822 823 CLOSE( inumcoo ) 824 825 ! set extra rows add in mpp to none zero values 826 DO jj = nlcj+1, jpj 827 DO ji = 1, nlci 828 glamt(ji,jj) = glamt(ji,1) ; gphit(ji,jj) = gphit(ji,1) 829 glamu(ji,jj) = glamu(ji,1) ; gphiu(ji,jj) = gphiu(ji,1) 830 glamv(ji,jj) = glamv(ji,1) ; gphiv(ji,jj) = gphiv(ji,1) 831 glamf(ji,jj) = glamf(ji,1) ; gphif(ji,jj) = gphif(ji,1) 832 e1t (ji,jj) = e1t (ji,1) ; e2t (ji,jj) = e2t (ji,1) 833 e1u (ji,jj) = e1u (ji,1) ; e2u (ji,jj) = e2u (ji,1) 834 e1v (ji,jj) = e1v (ji,1) ; e2v (ji,jj) = e2v (ji,1) 835 e1f (ji,jj) = e1f (ji,1) ; e2f (ji,jj) = e2f (ji,1) 836 END DO 837 END DO 838 839 ! set extra columns add in mpp to none zero values 840 DO ji = nlci+1, jpi 841 glamt(ji,:) = glamt(1,:) ; gphit(ji,:) = gphit(1,:) 842 glamu(ji,:) = glamu(1,:) ; gphiu(ji,:) = gphiu(1,:) 843 glamv(ji,:) = glamv(1,:) ; gphiv(ji,:) = gphiv(1,:) 844 glamf(ji,:) = glamf(1,:) ; gphif(ji,:) = gphif(1,:) 845 e1t (ji,:) = e1t (1,:) ; e2t (ji,:) = e2t (1,:) 846 e1u (ji,:) = e1u (1,:) ; e2u (ji,:) = e2u (1,:) 847 e1v (ji,:) = e1v (1,:) ; e2v (ji,:) = e2v (1,:) 848 e1f (ji,:) = e1f (1,:) ; e2f (ji,:) = e2f (1,:) 849 END DO 850 851 END SUBROUTINE hgr_read_fdir 852 588 853 !!====================================================================== 589 854 END MODULE domhgr
Note: See TracChangeset
for help on using the changeset viewer.
