New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 473 for trunk/NEMO/OPA_SRC/DOM/domhgr.F90 – NEMO

Ignore:
Timestamp:
2006-05-11T17:04:37+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_060: SM: IOM + 301 levels + CORE + begining of ctl_stop

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/DOM/domhgr.F90

    r434 r473  
    44   !! Ocean initialization : domain initialization 
    55   !!============================================================================== 
     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   !!---------------------------------------------------------------------- 
    619 
    720   !!---------------------------------------------------------------------- 
     
    2740   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    2841   !! $Header$  
    29    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     42   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3043   !!---------------------------------------------------------------------- 
    3144 
     
    8497      !!        define ff: coriolis factor at f-point 
    8598      !! 
    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. 
    100101      !!---------------------------------------------------------------------- 
    101       !! * local declarations 
    102102      INTEGER  ::   ji, jj              ! dummy loop indices 
    103103      INTEGER  ::   ii0, ii1, ij0, ij1  ! temporary integers 
     
    164164            IF(lwp) WRITE(numout,*) 
    165165            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' 
    166197            ! 
    167198         ENDIF 
     
    269300         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type' 
    270301         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 !!!! ' ) 
    276303 
    277304         !  Find index corresponding to the equator, given the grid spacing e1_deg 
     
    368395 
    369396      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 ) 
    373399 
    374400      END SELECT 
     
    480506      IF( nperio == 2 ) THEN 
    481507         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' ) 
    487509      ENDIF 
    488510 
     
    499521      !!      or semi-analytical method. It is read in a NetCDF file.  
    500522      !!      
    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 code 
    507       !!        !  91-03  (G. Madec) 
    508       !!        !  92-07  (M. Imbard) 
    509       !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL 
    510       !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb 
    511       !!   8.5  !  02-06  (G. Madec)  F90: Free form 
    512523      !!---------------------------------------------------------------------- 
    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 
    526527      !!---------------------------------------------------------------------- 
    527       clname = 'coordinates' 
    528 #if defined key_agrif 
    529       if ( .NOT. Agrif_Root() ) then 
    530          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    531       endif 
    532 #endif          
    533  
    534  
    535       ! 1. Read of the grid coordinates and scale factors 
    536       ! ------------------------------------------------- 
    537528 
    538529      IF(lwp) THEN 
    539530         WRITE(numout,*) 
    540531         WRITE(numout,*) 'hgr_read : read the horizontal coordinates' 
    541          WRITE(numout,*) '~~~~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
     532         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    542533      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     
    680561   !!====================================================================== 
    681562END MODULE domhgr 
Note: See TracChangeset for help on using the changeset viewer.