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 – NEMO

Changeset 473 for trunk/NEMO/OPA_SRC


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

Location:
trunk/NEMO/OPA_SRC
Files:
28 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 

  • trunk/NEMO/OPA_SRC/DOM/domzgr.F90

    r454 r473  
    9393      IF( ln_zps ) ioptio = ioptio + 1 
    9494      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' ) 
    10096 
    10197      IF( ln_zco ) THEN 
    10298          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' ) 
    108100      ENDIF 
    109101 
    … …  
    264256 
    265257      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 ' ) 
    276260      END DO 
    277261 
    … …  
    318302      !!---------------------------------------------------------------------- 
    319303      !! * Modules used 
    320       USE ioipsl 
     304      USE iom 
    321305 
    322306      !! * Local declarations 
    323       CHARACTER (len=18) ::   clname    ! temporary characters 
    324       LOGICAL ::   llbon                ! check the existence of bathy files 
    325307      INTEGER ::   ji, jj, jl, jk       ! dummy loop indices 
    326       INTEGER ::   inum = 11            ! temporary logical unit 
     308      INTEGER ::   inum                 ! temporary logical unit 
    327309      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 
    332311      INTEGER , DIMENSION(jpidta,jpjdta) ::   & 
    333312         idta                           ! global domain integer data 
    334313      REAL(wp) ::   & 
    335314         r_bump, h_bump, h_oce,      &  ! bump characteristics  
    336          zi, zj, zdate0, zdt, zh        ! temporary scalars 
     315         zi, zj, zh                     ! temporary scalars 
    337316      REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    338          zlamt, zphit,               &  ! 2D workspace (NetCDF read) 
    339317         zdta                           ! global domain scalar data 
    340       REAL(wp), DIMENSION(jpk) ::   & 
    341          zdept                          ! 1D workspace (NetCDF read) 
    342318      !!---------------------------------------------------------------------- 
    343319 
    … …  
    427403         ENDIF 
    428404 
     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 
    429419         !                                            ! =============== ! 
    430420      ELSEIF( ntopo == 1 ) THEN                       !   read in file  ! 
    431421         !                                            ! =============== ! 
    432422 
    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  
    453429            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 ' ) 
    457431            ELSE 
    458432               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       
    460435            ENDIF 
    461436         ENDIF 
    462437 
    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  
    482443            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 ' ) 
    486445            ELSE 
    487                zdta(:,:) = 0.e0 
     446               bathy(:,:) = 0.e0        ! initialisation 
     447               nstop = nstop - 1        ! supress the error count for opening 'bathy_level.nc' 
    488448               IF(lwp) WRITE(numout,*)'    zgr_bat : bathy_meter not found, but not used, bathy array set to zero' 
    489449            ENDIF 
    … …  
    492452      ELSE                                            !      error      ! 
    493453         !                                            ! =============== ! 
    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 
    516457 
    517458      ! ======================= 
    … …  
    531472      ENDIF 
    532473 
     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 
    533479      ! =========== 
    534480      ! Zoom domain  
    … …  
    12211167         WRITE(numout,9430) (jk,fsdept(1,1,jk),fsdepw(1,1,jk),     & 
    12221168                             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 
    12351189      ENDIF 
    12361190 

  • trunk/NEMO/OPA_SRC/DTA/dtasal.F90

    r459 r473  
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE in_out_manager  ! I/O manager 
     16   USE phycst          ! physical constants 
    1617   USE daymod          ! calendar 
     18#if defined key_orca_lev10 
     19   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     20#endif 
    1721 
    1822   IMPLICIT NONE 
    … …  
    2933   !! * Module variables 
    3034   INTEGER ::   & 
    31       nlecsa = 0,   &  ! switch for the first read 
    32       nsal1     ,   &  ! first record used 
    33       nsal2            ! second record used 
     35      numsdt,           &  !: logical unit for data salinity 
     36      nsal1, nsal2         ! first and second record used 
    3437   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    3538      saldta    ! salinity data at two consecutive times 
    … …  
    5053 
    5154   SUBROUTINE dta_sal( kt ) 
    52       !!---------------------------------------------------------------------- 
    53       !!                   ***  ROUTINE dta_sal  *** 
    54       !!         
    55       !! ** Purpose :   Reads monthly salinity data 
    56       !!              
    57       !! ** Method  : - Read on unit numsdt the monthly salinity data interpo- 
    58       !!     lated onto the model grid. 
    59       !!              - At each time step, a linear interpolation is applied 
    60       !!     between two monthly values. 
    61       !! 
    62       !! History : 
    63       !!        !  91-03  ()  Original code 
    64       !!        !  92-07  (M. Imbard) 
    65       !!   9.0  !  02-06  (G. Madec)  F90: Free form and module  
    66       !!---------------------------------------------------------------------- 
    67       !! * Modules used 
    68       USE ioipsl 
    69  
    70       !! * Arguments 
    71       INTEGER, INTENT(in) ::   kt             ! ocean time step 
    72  
    73       !! * Local declarations 
    74       CHARACTER (len=32) ::   clname 
    75  
    76       INTEGER, PARAMETER ::   jpmois = 12, jpf = 1 
    77       INTEGER ::   ji, jj, jl, jkk  ! dummy loop indicies 
    78       REAL(wp), DIMENSION(jpk,2) ::   & 
    79          zsaldta            ! auxiliary array for interpolation 
    80  
    81       INTEGER ::   & 
    82          imois, iman, ik, i15,       &  ! temporary integers 
    83          ipi, ipj, ipk, itime           !    "          " 
    84 #if defined key_tradmp 
    85       INTEGER ::   & 
    86          jk, il0, il1,               &  ! temporary integers 
    87          ii0, ii1, ij0, ij1             !    "          " 
    88 #endif 
    89       INTEGER, DIMENSION(jpmois) ::   istep 
    90       REAL(wp) ::   & 
    91          zxy, zl, zdate0 
    92       REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat 
    93       REAL(wp), DIMENSION(jpk) ::   zlev 
    94       !!---------------------------------------------------------------------- 
    95  
     55     !!---------------------------------------------------------------------- 
     56     !!                   ***  ROUTINE dta_sal  *** 
     57     !!         
     58     !! ** Purpose :   Reads monthly salinity data 
     59     !!              
     60     !! ** Method  : - Read on unit numsdt the monthly salinity data interpo- 
     61     !!     lated onto the model grid. 
     62     !!              - At each time step, a linear interpolation is applied 
     63     !!     between two monthly values. 
     64     !! 
     65     !! History : 
     66     !!        !  91-03  ()  Original code 
     67     !!        !  92-07  (M. Imbard) 
     68     !!   9.0  !  02-06  (G. Madec)  F90: Free form and module  
     69     !!---------------------------------------------------------------------- 
     70     !! * Modules used 
     71     USE iom 
     72      
     73     !! * Arguments 
     74     INTEGER, INTENT(in) ::   kt             ! ocean time step 
     75      
     76     !! * Local declarations 
     77      
     78     INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
     79     INTEGER ::   & 
     80          imois, iman, i15, ik           ! temporary integers 
     81#  if defined key_tradmp 
     82     INTEGER ::   & 
     83          il0, il1, ii0, ii1, ij0, ij1   ! temporary integers          
     84# endif 
     85     REAL(wp) ::   zxy, zl 
     86#if defined key_orca_lev10 
     87     REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal 
     88     INTEGER   :: ikr, ikw, ikt, jjk 
     89     REAL(wp)  :: zfac 
     90#endif 
     91     REAL(wp), DIMENSION(jpk,2) ::   & 
     92          zsaldta            ! auxiliary array for interpolation 
     93     !!---------------------------------------------------------------------- 
     94      
    9695     ! 0. Initialization 
    9796     ! ----------------- 
    98  
    99      iman  = jpmois 
     97      
     98     iman  = INT( raamo ) 
     99!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    100100     i15   = nday / 16 
    101  
    102101     imois = nmonth + i15 - 1 
    103102     IF( imois == 0 ) imois = iman 
    104  
    105      itime = jpmois 
    106      ipi=jpiglo 
    107      ipj=jpjglo 
    108      ipk = jpk 
    109  
     103      
    110104     ! 1. First call kt=nit000 
    111105     ! ----------------------- 
    112  
    113      IF( kt == nit000 .AND. nlecsa == 0 ) THEN 
    114    nsal1 = 0 
    115    IF(lwp) THEN 
    116       WRITE(numout,*) 
    117       WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
    118       WRITE(numout,*) ' ~~~~~~~' 
    119       WRITE(numout,*) 
    120    ENDIF 
    121  
    122    ! open file 
    123  
    124    clname = 'data_1m_salinity_nomask' 
    125 #if defined key_agrif 
    126    if ( .NOT. Agrif_Root() ) then 
    127       clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    128    endif 
    129 #endif              
    130    CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   & 
    131         ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt) 
    132  
    133    ! title, dimensions and tests 
    134  
    135    IF( itime /= jpmois ) THEN 
    136       IF(lwp) THEN 
    137          WRITE(numout,*) 
    138          WRITE(numout,*) 'problem with time coordinates' 
    139          WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    140       ENDIF 
    141       STOP 'dta_sal' 
    142    ENDIF 
    143    IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    144       IF(lwp) THEN 
    145          WRITE(numout,*) 
    146          WRITE(numout,*) 'problem with dimensions' 
    147          WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    148          WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    149          WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
    150       ENDIF 
    151       STOP 'dta_sal' 
    152    ENDIF 
    153    IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numsdt 
    154  
     106      
     107     IF( kt == nit000 ) THEN 
     108         
     109        nsal1 = 0   ! initializations 
     110        IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
     111        CALL iom_open ( 'data_1m_salinity_nomask', numsdt )  
     112         
    155113     ENDIF 
    156  
    157  
     114      
     115      
    158116     ! 2. Read monthly file 
    159117     ! ------------------- 
    160  
    161      IF( ( kt == nit000 .AND. nlecsa == 0) .OR. imois /= nsal1 ) THEN 
    162    nlecsa = 1 
    163  
    164    ! 2.1 Calendar computation 
    165  
    166    nsal1 = imois        ! first file record used  
    167    nsal2 = nsal1 + 1    ! last  file record used 
    168    nsal1 = MOD( nsal1, iman ) 
    169    IF( nsal1 == 0 ) nsal1 = iman 
    170    nsal2 = MOD( nsal2, iman ) 
    171    IF( nsal2 == 0 ) nsal2 = iman 
    172    IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 
    173    IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2 
    174  
    175    ! 2.3 Read monthly salinity data Levitus  
    176  
    177    CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal1,   & 
    178      nsal1,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,1)) 
    179  
    180    CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal2,   & 
    181      nsal2,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,2)) 
    182  
    183  
    184    IF(lwp) THEN 
    185       WRITE(numout,*) 
    186       WRITE(numout,*) ' read Levitus salinity ok' 
    187       WRITE(numout,*) 
    188    ENDIF 
    189  
     118      
     119     IF( kt == nit000 .OR. imois /= nsal1 ) THEN 
     120         
     121        ! 2.1 Calendar computation 
     122         
     123        nsal1 = imois        ! first file record used  
     124        nsal2 = nsal1 + 1    ! last  file record used 
     125        nsal1 = MOD( nsal1, iman ) 
     126        IF( nsal1 == 0 ) nsal1 = iman 
     127        nsal2 = MOD( nsal2, iman ) 
     128        IF( nsal2 == 0 ) nsal2 = iman 
     129        IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 
     130        IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2 
     131         
     132        ! 2.3 Read monthly salinity data Levitus  
     133         
     134#if defined key_orca_lev10 
     135        if (lk_zps) stop 
     136        zsal(:,:,:,:) = 0. 
     137        CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1) 
     138        CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2) 
     139#else 
     140        CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,1),nsal1) 
     141        CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,2),nsal2) 
     142#endif 
     143         
     144        IF(lwp) THEN 
     145           WRITE(numout,*) 
     146           WRITE(numout,*) ' read Levitus salinity ok' 
     147           WRITE(numout,*) 
     148        ENDIF 
     149         
    190150#if defined key_tradmp 
    191    IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    192  
    193       !                                        ! ======================= 
    194       !                                        !  ORCA_R2 configuration 
    195       !                                        ! ======================= 
    196       ij0 = 101   ;   ij1 = 109 
    197       ii0 = 141   ;   ii1 = 155    
    198       DO jj = mj0(ij0), mj1(ij1)                      ! Reduced salinity in the Alboran Sea 
    199          DO ji = mi0(ii0), mi1(ii1) 
    200        DO jk = 13, 13 
    201           saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15 
    202        END DO 
    203        DO jk = 14, 15 
    204           saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.25 
    205        END DO 
    206        DO jk = 16, 17 
    207           saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.30 
    208        END DO 
    209        DO jk = 18, 25 
    210           saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.35 
    211        END DO 
    212          END DO 
    213       END DO 
    214       IF( n_cla == 1 ) THEN  
    215          !                                         ! New salinity profile at Gibraltar 
    216          il0 = 138   ;   il1 = 138    
    217          ij0 = 101   ;   ij1 = 101 
    218          ii0 = 139   ;   ii1 = 139    
    219          saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
    220        &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
    221          ij0 = 101   ;   ij1 = 101 
    222          saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
    223        &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
    224          il0 = 138   ;   il1 = 138    
    225          ij0 = 101   ;   ij1 = 102 
    226          ii0 = 139   ;   ii1 = 139    
    227          DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Gibraltar 
    228        DO jj = mj0(ij0), mj1(ij1) 
    229           DO ji = mi0(ii0), mi1(ii1) 
    230              saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    231           END DO 
    232        END DO 
    233          END DO 
    234  
    235          il0 = 164   ;   il1 = 164    
    236          ij0 =  88   ;   ij1 =  88 
    237          ii0 = 161   ;   ii1 = 163    
    238          DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Bab el Mandeb 
    239        DO jj = mj0(ij0), mj1(ij1) 
    240           DO ji = mi0(ii0), mi1(ii1) 
    241              saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    242           END DO 
    243        END DO 
    244        ij0 =  87   ;   ij1 =  87 
    245        DO jj = mj0(ij0), mj1(ij1) 
    246           DO ji = mi0(ii0), mi1(ii1) 
    247              saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    248           END DO 
    249        END DO 
    250          END DO 
    251  
    252       ENDIF 
    253  
    254    ENDIF 
     151        IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     152            
     153           !                                        ! ======================= 
     154           !                                        !  ORCA_R2 configuration 
     155           !                                        ! ======================= 
     156           ij0 = 101   ;   ij1 = 109 
     157           ii0 = 141   ;   ii1 = 155    
     158           DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea 
     159              DO ji = mi0(ii0), mi1(ii1) 
     160#if defined key_orca_lev10 
     161                 zsal  (ji,jj,13:13,:) = zsal  (ji,jj,13:13,:) - 0.15 
     162                 zsal  (ji,jj,14:15,:) = zsal  (ji,jj,14:15,:) - 0.25 
     163                 zsal  (ji,jj,16:17,:) = zsal  (ji,jj,16:17,:) - 0.30 
     164                 zsal  (ji,jj,18:25,:) = zsal  (ji,jj,18:25,:) - 0.35 
     165#else 
     166                 saldta(ji,jj,13:13,:) = saldta(ji,jj,13:13,:) - 0.15 
     167                 saldta(ji,jj,14:15,:) = saldta(ji,jj,14:15,:) - 0.25 
     168                 saldta(ji,jj,16:17,:) = saldta(ji,jj,16:17,:) - 0.30 
     169                 saldta(ji,jj,18:25,:) = saldta(ji,jj,18:25,:) - 0.35 
     170#endif 
     171              END DO 
     172           END DO 
     173           IF( n_cla == 1 ) THEN  
     174              !                                         ! New salinity profile at Gibraltar 
     175              il0 = 138   ;   il1 = 138    
     176              ij0 = 101   ;   ij1 = 101 
     177              ii0 = 139   ;   ii1 = 139    
     178#if defined key_orca_lev10 
     179              zsal  ( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     180                   &                          zsal  ( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     181#else 
     182              saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     183                   &                          saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     184#endif 
     185              ij0 = 101   ;   ij1 = 101 
     186#if defined key_orca_lev10 
     187              zsal  ( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     188                   &                          zsal  ( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     189#else 
     190              saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     191                   &                          saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     192#endif 
     193              il0 = 138   ;   il1 = 138    
     194              ij0 = 101   ;   ij1 = 102 
     195              ii0 = 139   ;   ii1 = 139    
     196              DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Gibraltar 
     197                 DO jj = mj0(ij0), mj1(ij1) 
     198                    DO ji = mi0(ii0), mi1(ii1) 
     199#if defined key_orca_lev10 
     200                       zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:) 
     201#else 
     202                       saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
     203#endif 
     204                    END DO 
     205                 END DO 
     206              END DO 
     207               
     208              il0 = 164   ;   il1 = 164    
     209              ij0 =  88   ;   ij1 =  88 
     210              ii0 = 161   ;   ii1 = 163    
     211              DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Bab el Mandeb 
     212                 DO jj = mj0(ij0), mj1(ij1) 
     213                    DO ji = mi0(ii0), mi1(ii1) 
     214#if defined key_orca_lev10 
     215                       zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:) 
     216#else 
     217                       saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
     218#endif 
     219                    END DO 
     220                 END DO 
     221                 ij0 =  87   ;   ij1 =  87 
     222                 DO jj = mj0(ij0), mj1(ij1) 
     223                    DO ji = mi0(ii0), mi1(ii1) 
     224#if defined key_orca_lev10 
     225                       zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:) 
     226#else 
     227                       saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
     228#endif 
     229                    END DO 
     230                 END DO 
     231              END DO 
     232               
     233           ENDIF 
     234            
     235        ENDIF 
    255236#endif    
    256  
    257      IF( ln_sco ) THEN 
    258      DO jl = 1, 2 
    259    DO jj = 1, jpj                  ! interpolation of salinites 
    260       DO ji = 1, jpi 
    261          DO jk = 1, jpk 
    262         zl=fsdept(ji,jj,jk) 
    263         IF(zl <  gdept_0(1)) zsaldta(jk,jl) =  saldta(ji,jj,1,jl) 
    264         IF(zl >  gdept_0(jpk)) zsaldta(jk,jl) =  saldta(ji,jj,jpkm1,jl) 
    265         DO jkk = 1, jpkm1 
    266             IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
    267            zsaldta(jk,jl) = saldta(ji,jj,jkk,jl)                                  & 
    268               &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))       & 
    269               &                              *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 
    270             ENDIF 
    271         END DO 
    272          END DO 
    273          DO jk = 1, jpkm1 
    274              saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 
    275          END DO 
    276              saldta(ji,jj,jpk,jl) = 0.0 
    277       END DO 
    278    END DO 
    279      END DO 
    280  
    281      IF(lwp) WRITE(numout,*) 
    282      IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 
    283      IF(lwp) WRITE(numout,*) 
    284  
    285      ELSE 
    286      !                                     ! Mask 
    287      DO jl = 1, 2 
    288    saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 
    289    saldta(:,:,jpk,jl) = 0. 
    290    IF( ln_zps ) THEN                   ! z-coord. partial steps 
    291       DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    292          DO ji = 1, jpi 
    293        ik = mbathy(ji,jj) - 1 
    294        IF( ik > 2 ) THEN 
    295           zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    296           saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 
    297        ENDIF 
    298          END DO 
    299       END DO 
    300    ENDIF 
    301      END DO 
     237         
     238#if defined key_orca_lev10 
     239        !  interpolate from 31 to 301 level the zsal field result in saldta 
     240        DO jl = 1, 2 
     241           DO jjk = 1, 5 
     242              saldta(:,:,jjk,jl) = zsal(:,:,1,jl) 
     243           ENDDO 
     244           DO jk = 1, jpk - 20, 10 
     245              ikr = INT( jk / 10 ) + 1 
     246              ikw = (ikr-1) * 10 + 1 
     247              ikt = ikw + 5 
     248              DO jjk = ikt , ikt + 9 
     249                 zfac = ( gdept(jjk) - gdepw(ikt) ) / ( gdepw(ikt+10) - gdepw(ikt) ) 
     250                 saldta(:,:,jjk,jl) = zsal(:,:,ikr,jl) + ( zsal(:,:,ikr+1,jl) - zsal(:,:,ikr,jl) ) * zfac 
     251              END DO 
     252           END DO 
     253           DO jjk = jpk-5, jpk 
     254              saldta(:,:,jjk,jl) = zsal(:,:,jpkdta-1,jl) 
     255           END DO 
     256           ! fill the overlap areas 
     257           CALL lbc_lnk (saldta(:,:,:,jl),'Z',-999.,'no0') 
     258        END DO 
     259         
     260#endif 
     261         
     262        IF( ln_sco ) THEN 
     263           DO jl = 1, 2 
     264              DO jj = 1, jpj                  ! interpolation of salinites 
     265                 DO ji = 1, jpi 
     266                    DO jk = 1, jpk 
     267                       zl=fsdept(ji,jj,jk) 
     268                       IF(zl <  gdept_0(1)) zsaldta(jk,jl) =  saldta(ji,jj,1,jl) 
     269                       IF(zl >  gdept_0(jpk)) zsaldta(jk,jl) =  saldta(ji,jj,jpkm1,jl) 
     270                       DO jkk = 1, jpkm1 
     271                          IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     272                             zsaldta(jk,jl) = saldta(ji,jj,jkk,jl)                                  & 
     273                                  &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))       & 
     274                                  &                              *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 
     275                          ENDIF 
     276                       END DO 
     277                    END DO 
     278                    DO jk = 1, jpkm1 
     279                       saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 
     280                    END DO 
     281                    saldta(ji,jj,jpk,jl) = 0.0 
     282                 END DO 
     283              END DO 
     284           END DO 
     285            
     286           IF(lwp) WRITE(numout,*) 
     287           IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 
     288           IF(lwp) WRITE(numout,*) 
     289            
     290        ELSE 
     291           !                                  ! Mask 
     292           DO jl = 1, 2 
     293              saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 
     294              saldta(:,:,jpk,jl) = 0. 
     295              IF( ln_zps ) THEN               ! z-coord. partial steps 
     296                 DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     297                    DO ji = 1, jpi 
     298                       ik = mbathy(ji,jj) - 1 
     299                       IF( ik > 2 ) THEN 
     300                          zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     301                          saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 
     302                       ENDIF 
     303                    END DO 
     304                 END DO 
     305              ENDIF 
     306           END DO 
     307        ENDIF 
     308         
     309         
     310        IF(lwp) THEN 
     311           WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 
     312           WRITE(numout,*) 
     313           WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1' 
     314           CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     315           WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2 
     316           CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     317           WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1 
     318           CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     319        ENDIF 
    302320     ENDIF 
    303  
    304  
    305    IF(lwp) THEN 
    306       WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 
    307       WRITE(numout,*) 
    308       WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1' 
    309       CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    310       WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2 
    311       CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    312       WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1 
    313       CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    314    ENDIF 
    315      ENDIF 
    316  
    317  
     321      
     322      
    318323     ! 3. At every time step compute salinity data 
    319324     ! ------------------------------------------- 
    320  
     325      
    321326     zxy = FLOAT(nday + 15 - 30*i15)/30. 
    322327     s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 
     328      
     329     ! Close the file 
     330     ! -------------- 
     331      
     332     IF( kt == nitend )   CALL iom_close (numsdt) 
    323333 
    324334   END SUBROUTINE dta_sal 

  • trunk/NEMO/OPA_SRC/DTA/dtasss.F90

    r434 r473  
    2727   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasss = .FALSE.  !: sss data flag 
    2828#endif 
     29   INTEGER ::   numsss         !: logical unit for surface salinity data 
    2930   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    3031      sss             !: surface salinity 
    … …  
    6364      !!---------------------------------------------------------------------- 
    6465      !! * Modules used 
    65       USE ioipsl 
     66      USE iom 
    6667       
    6768      !! * Arguments 
    6869      INTEGER ::   kt 
    6970 
    70       !! * Local declarations 
    71       INTEGER ::   idy 
    72       INTEGER ::   istep(1) 
    73       INTEGER ::   ipi, ipj, ipk 
    74  
    75       REAL(wp) ::   zdate0, zdt 
    76       REAL(wp) ::   zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk) 
    77       CHARACTER (len=45) ::   & 
    78          clname = "sss.nc"      ! filename for SSS 
    7971      !!---------------------------------------------------------------------- 
    8072 
    8173      IF( kt == nit000 ) THEN 
     74 
    8275         IF(lwp) WRITE(numout,*) 
    83          IF(lwp) WRITE(numout,*) 'dta_sss : sea surface salinity data' 
    84          IF(lwp) WRITE(numout,*) '~~~~~~~   read in file: ', clname 
    85          sss(:,:) = 0.e0   ! required for extra halos in mpp 
     76         IF(lwp) WRITE(numout,*) 'dta_sss : yearly mean sea surface salinity data' 
    8677 
    87          ipi = jpiglo 
    88          ipj = jpjglo 
    89          ipk = 0 
     78         CALL iom_open ( 'sss.nc', numsss )  
     79         CALL iom_get ( numsss, jpdom_data, 'sss', sss, 1 ) 
     80         CALL iom_close ( numsss ) 
    9081 
    91          zdate0 = 0.e0 
    92          zdt = 0.e0 
    93          IF(lwp) WRITE (numout,*) 'open sss file = ', clname 
    94  
    95          CALL flinopen( TRIM(clname), mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj,  & 
    96             &           ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsss ) 
    97  
    98  
    99          IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 
    100             IF(lwp) WRITE(numout,*) 
    101             IF(lwp) WRITE(numout,*) 'problem with dimensions' 
    102             IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta 
    103             IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta 
    104             nstop = nstop + 1 
    105          ENDIF 
    106          IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt  
    107  
    108          CALL flinget( numsss, 'sss', jpidta, jpjdta, 1, idy, 1,   & 
    109             &          1, mig(1), nlci, mjg(1), nlcj, sss(1:nlci,1:nlcj) ) 
    110           
    11182         sss(:,:) = sss(:,:)*tmask(:,:,1) 
    11283 
    113          IF( kt == nit000 .AND. lwp ) THEN 
     84         IF( lwp ) THEN 
    11485            WRITE(numout,*) ' ' 
    11586            WRITE(numout,*) ' read  sea surface salinity ok' 
    11687            WRITE(numout,*) ' ' 
    117             CALL prihre(sss(1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout) 
     88            CALL prihre(sss(:,:),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout) 
    11889         ENDIF 
    119          CALL flinclo(numsss) 
    12090 
    12191      ENDIF 

  • trunk/NEMO/OPA_SRC/DTA/dtasst.F90

    r392 r473  
    2727#if defined key_dtasst 
    2828   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   !: sst data flag 
     29   INTEGER ::   & 
     30        numsst ,      &              !: logical unit for surface temperature data 
     31        ndaysst                      !: new day for Reynolds sst 
     32   CHARACTER (len=34) :: clname      !: filename for daily SST 
    2933#else 
    3034   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .FALSE.  !: sst data flag 
    … …  
    7175      !!---------------------------------------------------------------------- 
    7276      !! * Modules used 
    73       USE ioipsl 
     77      USE iom 
    7478       
    7579      !! * Arguments 
    … …  
    7781 
    7882      !! * Local save 
    79       INTEGER, SAVE ::   & 
    80       ndaysst,        &  ! new day for Reynolds sst 
    81       nyearsst           ! new year for Reynolds sst 
    8283 
    8384      !! * Local declarations 
    8485      INTEGER ::   ji, jj 
    85       INTEGER ::   iprint 
    86       INTEGER ::   iy, iday, idy 
    87       INTEGER ::   istep(366) 
    88       INTEGER ::   ipi, ipj, ipk 
     86      !!---------------------------------------------------------------------- 
    8987 
    90       REAL(wp) ::   zdate0, zdt, ztgel 
    91       REAL(wp) ::   zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk) 
    92       CHARACTER (len=45) ::   & 
    93          clname       ! filename for daily SST 
    94       !!---------------------------------------------------------------------- 
    95          clname = 'sst_1d.nc' 
    96 #if defined key_agrif 
    97       if ( .NOT. Agrif_Root() ) then 
    98          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    99       endif 
    100 #endif          
     88      ! -------------------- ! 
     89      ! First call kt=nit000 ! 
     90      ! -------------------- ! 
     91 
    10192      IF( kt == nit000 ) THEN 
    102          IF(lwp) WRITE(numout,*) 
     93 
     94         ndaysst = 0   ! initializations 
    10395         IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data' 
    104          IF(lwp) WRITE(numout,*) '~~~~~~~   read in file: ', clname 
    105          sst(:,:) = 0.e0   ! required for extra halos in mpp 
     96         CALL iom_open ( 'sst_1d.nc', numsst )  
     97 
    10698      ENDIF 
    10799 
    108  
    109       ! 0. initialization 
    110       ! ----------------- 
    111  
    112       ipi = jpiglo 
    113       ipj = jpjglo 
    114       ipk = jpk 
    115  
    116       IF( nleapy == 0 ) THEN 
    117          idy=365 
    118       ELSEIF( nleapy == 1 ) THEN 
    119          IF( MOD( nyear, 4 ) == 0 ) THEN 
    120             idy=366 
    121          ELSE 
    122             idy=365 
    123          ENDIF 
    124       ELSEIF( nleapy == 30 ) THEN 
    125          IF(lwp) WRITE(numout,*) 'dtasst : nleapy = 30 is not compatible' 
    126          IF(lwp) WRITE(numout,*) '         with existing files' 
    127          IF(lwp) WRITE(numout,*) 'WE STOP' 
    128          STOP 1234 
    129       ENDIF 
    130        
    131        
    132       ! 2. Open files if nyearsst 
    133       ! ------------------------- 
    134  
    135       IF( nyearsst /= nyear ) THEN 
    136          nyearsst = nyear 
    137          iprint   = 1 
    138           
    139          !  2.1 Define file name and record 
    140           
    141          !   Close/open file if new year  
    142           
    143          IF( nyearsst /= 0 )   CALL flinclo(numsst) 
    144          iy = nyear 
    145          IF(lwp) WRITE (numout,*) iy 
    146          IF(lwp) WRITE (numout,*) 'open sst file = ', clname 
    147          CALL FLUSH(numout) 
    148           
    149          CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj   & 
    150             , ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsst ) 
    151           
    152          IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 
    153             IF(lwp) WRITE(numout,*) 
    154             IF(lwp) WRITE(numout,*) 'problem with dimensions' 
    155             IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta 
    156             IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta 
    157             nstop = nstop + 1 
    158          ENDIF 
    159          IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt 
    160       ELSE 
    161          iprint = 0 
    162       ENDIF 
    163  
    164  
    165       ! 3. Read SST if new day 
    166       ! ------------------------- 
     100      ! ----------------- ! 
     101      ! Read daily file   ! 
     102      ! ----------------- ! 
    167103 
    168104      ! Read daily SST  
    … …  
    170106      IF( ndaysst /= nday ) THEN  
    171107         ndaysst = nday 
    172          iday = nday_year 
    173           
    174          CALL flinget( numsst, 'sst', jpidta, jpjdta, 1, idy, iday,   & 
    175             iday, mig(1), nlci, mjg(1), nlcj, sst(1:nlci,1:nlcj) ) 
    176           
     108 
     109         CALL iom_get ( numsst, jpdom_data, 'sst', sst, ndaysst ) 
     110 
    177111         IF ( kt == nit000 .AND. lwp ) THEN 
    178112            WRITE(numout,*) ' ' 
    … …  
    180114            WRITE(numout,*) ' ' 
    181115            WRITE(numout,*) ' Surface temp day: ', ndastp 
    182             CALL prihre(sst(1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout) 
     116            CALL prihre(sst(:,:),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout) 
    183117         ENDIF 
    184118          
    … …  
    201135         WRITE(numout,*) 
    202136         WRITE(numout,*) 'Ice cover : ' 
    203          CALL prihre( rclice(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 
     137         CALL prihre( rclice(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 
    204138      ENDIF 
    205139       
    … …  
    207141      ! -------------- 
    208142       
    209       IF( kt == nitend )   CALL flinclo(numsst) 
    210       CALL FLUSH(numout) 
     143      IF( kt == nitend )   CALL iom_close (numsst) 
    211144       
    212145 

  • trunk/NEMO/OPA_SRC/DTA/dtatem.F90

    r459 r473  
    99   !!---------------------------------------------------------------------- 
    1010   !!   dta_tem      : read ocean temperature data 
    11    !!---------------------------------------------------------------------- 
     11   !!---l------------------------------------------------------------------- 
    1212   !! * Modules used 
    1313   USE oce             ! ocean dynamics and tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    1515   USE in_out_manager  ! I/O manager 
     16   USE phycst          ! physical constants 
    1617   USE daymod          ! calendar 
    17  
     18#if defined key_orca_lev10 
     19   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     20#endif 
    1821   IMPLICIT NONE 
    1922   PRIVATE 
    … …  
    2831 
    2932   !! * Module variables 
    30    CHARACTER (len=45) ::   & 
    31       cl_tdata 
    3233   INTEGER ::   & 
    33       nlecte =  0,   &  ! switch for the first read 
    34       ntem1      ,   &  ! first record used 
    35       ntem2             ! second record used 
     34      numtdt,        &  !: logical unit for data temperature 
     35      ntem1, ntem2  ! first and second record used 
    3636   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    3737      temdta            ! temperature data at two consecutive times 
    … …  
    7575      !!---------------------------------------------------------------------- 
    7676      !! * Modules used 
    77       USE ioipsl 
     77      USE iom 
    7878 
    7979      !! * Arguments 
    … …  
    8181 
    8282      !! * Local declarations 
    83       INTEGER, PARAMETER ::   & 
    84          jpmois = 12                    ! number of month 
    85       INTEGER ::   ji, jj, jk, jl, jkk  ! dummy loop indicies 
    86       REAL(wp), DIMENSION(jpk,2) ::   & 
    87          ztemdta            ! auxiliary array for interpolation 
    88  
     83      INTEGER ::   ji, jj, jl, jk, jkk       ! dummy loop indicies 
    8984      INTEGER ::   & 
    90          imois, iman, itime, ik ,    &  ! temporary integers 
    91          i15, ipi, ipj, ipk             !    "          " 
     85         imois, iman, i15 , ik      ! temporary integers 
    9286#  if defined key_tradmp 
    9387      INTEGER ::   & 
    9488         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
    9589# endif 
    96  
    97       INTEGER, DIMENSION(jpmois) ::   istep 
    98       REAL(wp) ::   zxy, zl, zdate0 
    99       REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat 
    100       REAL(wp), DIMENSION(jpk) ::   zlev 
     90      REAL(wp) ::   zxy, zl 
     91#if defined key_orca_lev10 
     92      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 
     93      INTEGER   :: ikr, ikw, ikt, jjk  
     94      REAL(wp)  :: zfac 
     95#endif 
     96      REAL(wp), DIMENSION(jpk,2) ::   & 
     97         ztemdta            ! auxiliary array for interpolation 
    10198      !!---------------------------------------------------------------------- 
    102  
    103      ! 0. Initialization 
    104      ! ----------------- 
    105  
    106      iman  = jpmois 
    107      i15   = nday / 16 
    108      imois = nmonth + i15 - 1 
    109      IF( imois == 0 )   imois = iman 
    110  
    111      itime = jpmois 
    112      ipi = jpiglo 
    113      ipj = jpjglo 
    114      ipk = jpk 
    115  
    116      ! 1. First call kt=nit000 
    117      ! ----------------------- 
    118  
    119      IF( kt == nit000 .AND. nlecte == 0 ) THEN 
    120    ntem1 = 0 
    121    IF(lwp) WRITE(numout,*) 
    122    IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 
    123    IF(lwp) WRITE(numout,*) ' ~~~~~~' 
    124    IF(lwp) WRITE(numout,*) '             NetCDF FORMAT' 
    125    IF(lwp) WRITE(numout,*) 
    126  
    127    ! open file 
    128  
    129    cl_tdata = 'data_1m_potential_temperature_nomask ' 
    130 #if defined key_agrif 
    131    if ( .NOT. Agrif_Root() ) then 
    132       cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 
    133    endif 
    134 #endif             
    135    CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   & 
    136       &          , .false.     , ipi   , ipj  , ipk   , zlon     & 
    137       &          , zlat        , zlev  , itime, istep , zdate0   & 
    138       &          , rdt         , numtdt                        ) 
    139  
    140    ! title, dimensions and tests 
    141  
    142    IF( itime /= jpmois ) THEN 
    143       IF(lwp) THEN 
    144          WRITE(numout,*) 
    145          WRITE(numout,*) 'problem with time coordinates' 
    146          WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    147       ENDIF 
    148       STOP 'dtatem' 
    149    ENDIF 
    150    IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    151       IF(lwp) THEN 
    152          WRITE(numout,*) 
    153          WRITE(numout,*) 'problem with dimensions' 
    154          WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    155          WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    156          WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
    157       ENDIF 
    158       STOP 'dtatem' 
    159    ENDIF 
    160    IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 
    161  
    162      ENDIF 
    163  
    164  
    165      ! 2. Read monthly file 
    166      ! ------------------- 
    167  
    168      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 
    169    nlecte = 1 
    170  
    171    ! Calendar computation 
    172  
    173    ntem1 = imois        ! first file record used  
    174    ntem2 = ntem1 + 1    ! last  file record used 
    175    ntem1 = MOD( ntem1, iman ) 
    176    IF( ntem1 == 0 )   ntem1 = iman 
    177    ntem2 = MOD( ntem2, iman ) 
    178    IF( ntem2 == 0 )   ntem2 = iman 
    179    IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 
    180    IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2 
    181  
    182    ! Read monthly temperature data Levitus  
    183  
    184    CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   & 
    185           , jpmois, ntem1     , ntem1 , mig(1), nlci   & 
    186           , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     ) 
    187    CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   & 
    188           , jpmois, ntem2     , ntem2 , mig(1), nlci   & 
    189           , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     ) 
    190  
    191    IF(lwp) WRITE(numout,*) 
    192    IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 
    193    IF(lwp) WRITE(numout,*) 
    194  
     99       
     100      ! 0. Initialization 
     101      ! ----------------- 
     102       
     103      iman  = INT( raamo ) 
     104!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
     105      i15   = nday / 16 
     106      imois = nmonth + i15 - 1 
     107      IF( imois == 0 ) imois = iman 
     108       
     109      ! 1. First call kt=nit000 
     110      ! ----------------------- 
     111       
     112      IF( kt == nit000 ) THEN 
     113          
     114         ntem1= 0   ! initializations 
     115         IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 
     116         CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt )  
     117          
     118      ENDIF 
     119       
     120       
     121      ! 2. Read monthly file 
     122      ! ------------------- 
     123       
     124      IF( kt == nit000 .OR. imois /= ntem1 ) THEN 
     125          
     126         ! Calendar computation 
     127          
     128         ntem1 = imois        ! first file record used  
     129         ntem2 = ntem1 + 1    ! last  file record used 
     130         ntem1 = MOD( ntem1, iman ) 
     131         IF( ntem1 == 0 )   ntem1 = iman 
     132         ntem2 = MOD( ntem2, iman ) 
     133         IF( ntem2 == 0 )   ntem2 = iman 
     134         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 
     135         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2 
     136          
     137         ! Read monthly temperature data Levitus  
     138          
     139#if defined key_orca_lev10 
     140         if (lk_zps) stop 
     141         ztem(:,:,:,:) = 0. 
     142         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 
     143         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 
     144#else          
     145         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 
     146         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 
     147#endif 
     148          
     149         IF(lwp) WRITE(numout,*) 
     150         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 
     151         IF(lwp) WRITE(numout,*) 
     152          
    195153#if defined key_tradmp 
    196    IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    197  
    198       !                                        ! ======================= 
    199       !                                        !  ORCA_R2 configuration 
    200       !                                        ! =======================  
    201  
    202       ij0 = 101   ;   ij1 = 109 
    203       ii0 = 141   ;   ii1 = 155 
    204       DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
    205          DO ji = mi0(ii0), mi1(ii1) 
    206        temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 
    207        temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 
    208        temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 
    209          END DO 
    210       END DO 
    211  
    212       IF( n_cla == 0 ) THEN  
    213          !                                         ! Reduced temperature at Red Sea 
    214          ij0 =  87   ;   ij1 =  96 
    215          ii0 = 148   ;   ii1 = 160 
    216          temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
    217          temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
    218          temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
    219       ELSE 
    220          il0 = 138   ;   il1 = 138 
    221          ij0 = 101   ;   ij1 = 102 
    222          ii0 = 139   ;   ii1 = 139 
    223          DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar 
    224        DO jj = mj0(ij0), mj1(ij1) 
    225           DO ji = mi0(ii0), mi1(ii1) 
    226              temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    227           END DO 
    228        END DO 
    229          END DO 
    230          il0 = 164   ;   il1 = 164 
    231          ij0 =  88   ;   ij1 =  88 
    232          ii0 = 161   ;   ii1 = 163 
    233          DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb 
    234        DO jj = mj0(ij0), mj1(ij1) 
    235           DO ji = mi0(ii0), mi1(ii1) 
    236              temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    237           END DO 
    238        END DO 
    239        ij0 =  87   ;   ij1 =  87 
    240        DO jj = mj0(ij0), mj1(ij1) 
    241           DO ji = mi0(ii0), mi1(ii1) 
    242              temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    243           END DO 
    244        END DO 
    245          END DO 
    246       ENDIF 
    247  
    248    ENDIF 
    249 #endif 
    250  
    251      IF( ln_sco ) THEN 
    252      DO jl = 1, 2 
    253    DO jj = 1, jpj                  ! interpolation of temperatures 
    254       DO ji = 1, jpi 
    255          DO jk = 1, jpk 
    256         zl=fsdept(ji,jj,jk) 
    257         IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl) 
    258         IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl) 
    259         DO jkk = 1, jpkm1 
    260             IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
    261            ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 & 
    262               &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      & 
    263               &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 
    264             ENDIF 
    265         END DO 
    266          END DO 
    267          DO jk = 1, jpkm1 
    268              temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 
    269          END DO 
    270              temdta(ji,jj,jpk,jl) = 0.0 
    271       END DO 
    272    END DO 
    273      END DO 
    274  
    275      IF(lwp) WRITE(numout,*) 
    276      IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 
    277      IF(lwp) WRITE(numout,*) 
    278  
    279      ELSE 
    280  
    281      !                                  ! Mask 
    282      DO jl = 1, 2 
    283    temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 
    284    temdta(:,:,jpk,jl) = 0. 
    285    IF( ln_zps ) THEN                ! z-coord. with partial steps 
    286       DO jj = 1, jpj                  ! interpolation of temperature at the last level 
    287          DO ji = 1, jpi 
    288        ik = mbathy(ji,jj) - 1 
    289        IF( ik > 2 ) THEN 
    290           zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    291           temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
    292        ENDIF 
    293          END DO 
    294       END DO 
    295    ENDIF 
    296      END DO 
    297  
    298      ENDIF 
    299  
    300    IF(lwp) THEN 
    301       WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 
    302       WRITE(numout,*) 
    303       WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1' 
    304       CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    305       WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2 
    306       CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    307       WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1 
    308       CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    309    ENDIF 
    310      ENDIF 
    311  
    312  
    313      ! 2. At every time step compute temperature data 
    314      ! ---------------------------------------------- 
    315  
    316      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    317      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 
    318  
    319    END SUBROUTINE dta_tem 
     154         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     155             
     156            !                                        ! ======================= 
     157            !                                        !  ORCA_R2 configuration 
     158            !                                        ! =======================  
     159             
     160            ij0 = 101   ;   ij1 = 109 
     161            ii0 = 141   ;   ii1 = 155 
     162            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
     163               DO ji = mi0(ii0), mi1(ii1) 
     164#if defined key_orca_lev10 
     165                  ztem(  ji,jj, 13:13 ,:) = ztem  (ji,jj, 13:13 ,:) - 0.20 
     166                  ztem  (ji,jj, 14:15 ,:) = ztem  (ji,jj, 14:15 ,:) - 0.35 
     167                  ztem  (ji,jj, 16:25 ,:) = ztem  (ji,jj, 16:25 ,:) - 0.40 
     168#else 
     169                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 
     170                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 
     171                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 
     172#endif 
     173               END DO 
     174            END DO 
     175             
     176            IF( n_cla == 0 ) THEN  
     177               !                                         ! Reduced temperature at Red Sea 
     178               ij0 =  87   ;   ij1 =  96 
     179               ii0 = 148   ;   ii1 = 160 
     180#if defined key_orca_lev10 
     181               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
     182               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
     183               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
     184#else 
     185               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
     186               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
     187               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
     188#endif 
     189            ELSE 
     190               il0 = 138   ;   il1 = 138 
     191               ij0 = 101   ;   ij1 = 102 
     192               ii0 = 139   ;   ii1 = 139 
     193               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar 
     194                  DO jj = mj0(ij0), mj1(ij1) 
     195                     DO ji = mi0(ii0), mi1(ii1) 
     196#if defined key_orca_lev10 
     197                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:) 
     198#else 
     199                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
     200#endif 
     201                     END DO 
     202                  END DO 
     203               END DO 
     204               il0 = 164   ;   il1 = 164 
     205               ij0 =  88   ;   ij1 =  88 
     206               ii0 = 161   ;   ii1 = 163 
     207               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb 
     208                  DO jj = mj0(ij0), mj1(ij1) 
     209                     DO ji = mi0(ii0), mi1(ii1) 
     210#if defined key_orca_lev10 
     211                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:) 
     212#else 
     213                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
     214#endif 
     215                     END DO 
     216                  END DO 
     217                  ij0 =  87   ;   ij1 =  87 
     218                  DO jj = mj0(ij0), mj1(ij1) 
     219                     DO ji = mi0(ii0), mi1(ii1) 
     220#if defined key_orca_lev10 
     221                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:) 
     222#else 
     223                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
     224#endif 
     225                     END DO 
     226                  END DO 
     227               END DO 
     228            ENDIF 
     229             
     230         ENDIF 
     231#endif 
     232          
     233#if defined key_orca_lev10 
     234         ! interpolate from 31 to 301 level the ztem field result in temdta 
     235         DO jl = 1, 2 
     236            DO jjk = 1, 5 
     237               temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 
     238            END DO 
     239            DO jk = 1, jpk-20,10 
     240               ik = jk+5 
     241               ikr =  INT(jk/10) + 1 
     242               ikw =  (ikr-1) *10 + 1 
     243               ikt =  ikw + 5 
     244               DO jjk=ikt,ikt+9 
     245                  zfac = ( gdept(jjk   ) - gdepw(ikt) ) / ( gdepw(ikt+10) - gdepw(ikt) ) 
     246                  temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 
     247               END DO 
     248            END DO 
     249            DO jjk = jpk-5, jpk 
     250               temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 
     251            END DO 
     252            ! fill the overlap areas 
     253            CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 
     254         END DO 
     255#endif 
     256          
     257         IF( ln_sco ) THEN 
     258            DO jl = 1, 2 
     259               DO jj = 1, jpj                  ! interpolation of temperatures 
     260                  DO ji = 1, jpi 
     261                     DO jk = 1, jpk 
     262                        zl=fsdept(ji,jj,jk) 
     263                        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl) 
     264                        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl) 
     265                        DO jkk = 1, jpkm1 
     266                           IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     267                              ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 & 
     268                                   &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      & 
     269                                   &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 
     270                           ENDIF 
     271                        END DO 
     272                     END DO 
     273                     DO jk = 1, jpkm1 
     274                        temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 
     275                     END DO 
     276                     temdta(ji,jj,jpk,jl) = 0.0 
     277                  END DO 
     278               END DO 
     279            END DO 
     280             
     281            IF(lwp) WRITE(numout,*) 
     282            IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 
     283            IF(lwp) WRITE(numout,*) 
     284             
     285         ELSE 
     286             
     287            !                                  ! Mask 
     288            DO jl = 1, 2 
     289               temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 
     290               temdta(:,:,jpk,jl) = 0. 
     291               IF( ln_zps ) THEN                ! z-coord. with partial steps 
     292                  DO jj = 1, jpj                  ! interpolation of temperature at the last level 
     293                     DO ji = 1, jpi 
     294                        ik = mbathy(ji,jj) - 1 
     295                        IF( ik > 2 ) THEN 
     296                           zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     297                           temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
     298                        ENDIF 
     299                     END DO 
     300                  END DO 
     301               ENDIF 
     302            END DO 
     303             
     304         ENDIF 
     305          
     306         IF(lwp) THEN 
     307            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 
     308            WRITE(numout,*) 
     309            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1' 
     310            CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     311            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2 
     312            CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     313            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1 
     314            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     315         ENDIF 
     316      ENDIF 
     317       
     318       
     319      ! 2. At every time step compute temperature data 
     320      ! ---------------------------------------------- 
     321       
     322      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
     323      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 
     324       
     325      ! Close the file 
     326      ! -------------- 
     327       
     328      IF( kt == nitend )   CALL iom_close (numtdt) 
     329       
     330    END SUBROUTINE dta_tem 
    320331 
    321332#else 

  • trunk/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r461 r473  
    190190      !! * Modules used 
    191191      USE ldftra_oce, ONLY : aht0 
    192   
     192 
    193193      !! * Arguments 
    194194      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    … …  
    237237      ENDIF 
    238238111   CONTINUE 
    239       IF( iost /= 0 ) THEN 
    240          IF(lwp) THEN 
    241             WRITE(numout,*) 
    242             WRITE(numout,*) ' ===>>>> : bad opening file: ahmcoef,  we stop. verify the file ' 
    243             WRITE(numout,*) ' =======   ===  ' 
    244          ENDIF 
    245          nstop = nstop + 1 
    246       ENDIF 
    247  
     239      IF( iost /= 0 ) CALL ctl_stop( ' ',  & 
     240           &    ' ===>>>> : bad opening file: ahmcoef, verify the file ahmcoef', & 
     241           &    ' =======   ===  ' ) 
    248242      REWIND inum 
    249243      READ(inum,9101) clexp, iim, ijm 
    … …  
    375369      ! other level: re-increase the coef in the deep ocean 
    376370       
    377       DO jk = 1, 21 
     371#if defined key_orca_lev10 
     372      DO jk = 1, 210 
     373         zcoef(jk) = 1. 
     374      END DO 
     375      DO jk= 211, 230 
     376         zcoef(jk) = 1. + 0.1 * FLOAT(jk-210) 
     377      END DO 
     378      DO jk= 231, 260 
     379         zcoef(jk) = 3. + 0.2 * FLOAT(jk-230) 
     380      END DO 
     381      DO jk= 261, 270 
     382         zcoef(jk) = 9. + 0.1 * FLOAT(jk-260) 
     383      END DO 
     384      DO jk= 271, jpk 
     385         zcoef(jk) = 10. 
     386      END DO 
     387      DO jk= 1, jpk 
     388         IF(lwp) WRITE(numout,*) 'k= ',jk, 'cof ', zcoef(jk) 
     389      END DO 
     390#else 
     391       DO jk = 1, 21 
    378392         zcoef(jk) = 1. 
    379393      END DO 
    … …  
    386400         zcoef(jk) = 10. 
    387401      END DO 
    388        
     402#endif 
     403 
    389404      DO jk = 2, jpk 
    390405         ahm1(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm1(:,:,1) ) 

  • trunk/NEMO/OPA_SRC/OBC/obcdta.F90

    r465 r473  
    2626   USE lib_mpp         ! distributed memory computing 
    2727   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    28    USE ioipsl 
     28   USE iom 
     29#  if defined key_dynspg_rl 
    2930   USE obccli          ! climatological obc, use only in rigid-lid case 
     31#  endif 
    3032 
    3133   IMPLICIT NONE 
    … …  
    4143      ntobc1,   &  ! first record used 
    4244      ntobc2,   &  ! second record used 
    43       itobc        ! number of time steps in OBC files  
    44  
    45    REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc      ! time_counter variable of BCs 
     45      ntobc        ! number of time steps in OBC files  
     46 
     47   REAL(wp), DIMENSION(:), ALLOCATABLE :: tcobc      ! time_counter variable of BCs 
    4648 
    4749   !! * Substitutions 
    … …  
    7274      !!     attribute of variable time_counter). 
    7375      !! 
     76      !! History : 
     77      !!        !  98-05 (J.M. Molines) Original code 
     78      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90 
     79      !!   9.0  !  04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 
    7480      !!-------------------------------------------------------------------- 
    7581      !! * Arguments 
    … …  
    8389      !! * Ajouts FD 
    8490      INTEGER ::  isrel              ! number of seconds since 1/1/1992 
    85       INTEGER, SAVE ::  itobce, itobcw,  & ! number of time steps in OBC files 
    86                         itobcs, itobcn     !    "       "       "       " 
    87       INTEGER ::  ikprint        ! frequency for printouts. 
    88       INTEGER :: fid_e, fid_w, fid_n, fid_s       ! file identifiers 
    89       LOGICAL :: l_exv 
    90       INTEGER, DIMENSION(flio_max_dims) ::   f_d  ! dimensions lenght 
    91       
    92       CHARACTER(LEN=25) :: v_name 
     91      INTEGER, DIMENSION(1) ::  itobce, itobcw,  & ! number of time steps in OBC files 
     92                                itobcs, itobcn     !    "       "       "       " 
     93      INTEGER ::  istop         
     94      INTEGER ::  iprint        ! frequency for printouts. 
     95      INTEGER :: id_e, id_w, id_n, id_s       ! file identifiers 
     96      LOGICAL :: llnot_done 
     97      CHARACTER(LEN=25) :: cl_vname 
    9398      !!-------------------------------------------------------------------- 
    9499 
    95100      IF( lk_dynspg_rl )  THEN 
    96          CALL obc_dta_psi( kt )     ! update bsf data at open boundaries 
    97          IF( nobc_dta == 1 .AND. kt == nit000 ) THEN 
    98             IF(lwp) WRITE(numout,*) ' time-variable psi boundary data not allowed yet' 
    99             STOP 
    100          ENDIF 
     101         CALL obc_dta_psi (kt)     ! update bsf data at open boundaries 
     102         IF ( nobc_dta == 1 .AND. kt == nit000 ) CALL ctl_stop( 'obcdta : time-variable psi boundary data not allowed yet' ) 
    101103      ENDIF 
    102        
    103       CALL ipslnlf( new_number=numout ) 
    104       
     104            
    105105      ! 1.   First call: check time frames available in files. 
    106106      ! ------------------------------------------------------- 
    107107 
    108       IF( kt == nit000 )  THEN 
     108      IF ( kt == nit000 ) THEN 
    109109       
    110110         nlecto =  0 
    111111 
    112          IF(lwp) WRITE(numout,*) 
    113          IF(lwp) WRITE(numout,*)     'obc_dta : find boundary data' 
    114          IF(lwp) WRITE(numout,*)     '~~~~~~~' 
     112         IF (lwp) WRITE(numout,*) 
     113         IF (lwp) WRITE(numout,*)     'obc_dta : find boundary data' 
     114         IF (lwp) WRITE(numout,*)     '~~~~~~~' 
    115115              
    116          IF( nobc_dta == 0 )  THEN 
     116         IF ( nobc_dta == 0 ) THEN 
    117117            IF(lwp) WRITE(numout,*)  '  OBC data taken from initial conditions.' 
    118118            ntobc1 = 1 
    119119            ntobc2 = 1 
    120120         ELSE     
    121             IF(lwp) WRITE(numout,*)  '  OBC data taken from netcdf files.' 
    122             IF(lwp) WRITE(numout,*)  '  climatology (T/F):',ln_obc_clim 
     121            IF (lwp) WRITE(numout,*)  '  OBC data taken from netcdf files.' 
     122            IF (lwp) WRITE(numout,*)  '  climatology (T/F):',ln_obc_clim 
    123123            ! check the number of time steps in the files. 
    124             itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0 
    125             v_name = 'time_counter' 
    126             IF( lp_obc_east )   THEN 
    127                CALL flioopfd ('obceast_TS.nc',fid_e) 
    128                CALL flioinqv (fid_e,TRIM(v_name),l_exv,len_dims=f_d)  
    129                IF( l_exv )   THEN 
    130                   itobce = f_d(1) 
    131                ELSE 
    132                   WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obceast_TS.nc' 
     124            cl_vname = 'time_counter' 
     125            IF ( lp_obc_east ) THEN 
     126               CALL iom_open ( 'obceast_TS.nc' , id_e ) 
     127               idvar = iom_varid( id_e, cl_vname, kdimsz = itobce ) 
     128            ENDIF 
     129            IF ( lp_obc_west ) THEN 
     130               CALL iom_open ( 'obcwest_TS.nc' , id_w ) 
     131               idvar = iom_varid( id_w, cl_vname, kdimsz = itobcw ) 
     132            ENDIF 
     133            IF ( lp_obc_north ) THEN 
     134               CALL iom_open ( 'obcnorth_TS.nc', id_n ) 
     135               idvar = iom_varid( id_n, cl_vname, kdimsz = itobcn ) 
     136            ENDIF 
     137            IF ( lp_obc_south ) THEN 
     138               CALL iom_open ( 'obcsouth_TS.nc', id_s ) 
     139               idvar = iom_varid( id_s, cl_vname, kdimsz = itobcs ) 
     140            ENDIF 
     141 
     142            ntobc = MAX(itobce(1),itobcw(1),itobcn(1),itobcs(1)) 
     143            istop = 0 
     144            IF ( lp_obc_east  .AND. itobce(1) /= ntobc ) istop = 1  
     145            IF ( lp_obc_west  .AND. itobcw(1) /= ntobc ) istop = 1       
     146            IF ( lp_obc_north .AND. itobcn(1) /= ntobc ) istop = 1 
     147            IF ( lp_obc_south .AND. itobcs(1) /= ntobc ) istop = 1  
     148            IF ( istop /= 0 )  THEN 
     149               WRITE(ctmp1,*) ' east, west, north, south: ', itobce(1), itobcw(1), itobcn(1), itobcs(1) 
     150               CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 ) 
     151            ENDIF 
     152            IF ( ntobc == 1 ) THEN 
     153               IF ( lwp ) WRITE(numout,*) ' obcdta found one time step only in the OBC files' 
     154            ELSE 
     155               ALLOCATE (tcobc(ntobc)) 
     156               llnot_done = .TRUE. 
     157               IF ( lp_obc_east ) THEN 
     158                  IF ( llnot_done ) THEN 
     159                     CALL iom_gettime ( id_e, TRIM(cl_vname), tcobc ) 
     160                     llnot_done = .FALSE. 
     161                  ENDIF 
     162                  CALL iom_close (id_e) 
    133163               ENDIF 
    134             ENDIF 
    135             IF( lp_obc_west )   THEN 
    136                CALL flioopfd ('obcwest_TS.nc',fid_w) 
    137                CALL flioinqv (fid_w,TRIM(v_name),l_exv,len_dims=f_d)  
    138                IF( l_exv )   THEN 
    139                   itobcw = f_d(1) 
    140                ELSE 
    141                   WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obcwest_TS.nc' 
     164               IF ( lp_obc_west ) THEN 
     165                  IF ( llnot_done ) THEN 
     166                     CALL iom_gettime ( id_w, TRIM(cl_vname), tcobc ) 
     167                     llnot_done = .FALSE. 
     168                 ENDIF 
     169                 CALL iom_close (id_w) 
    142170               ENDIF 
    143             ENDIF 
    144             IF( lp_obc_north )   THEN 
    145                CALL flioopfd ('obcnorth_TS.nc',fid_n) 
    146                CALL flioinqv (fid_n,TRIM(v_name),l_exv,len_dims=f_d)  
    147                IF( l_exv )   THEN 
    148                   itobcn = f_d(1) 
    149                ELSE 
    150                   WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obcnorth_TS.nc' 
     171               IF ( lp_obc_north ) THEN 
     172                  IF ( llnot_done ) THEN 
     173                     CALL iom_gettime ( id_n, TRIM(cl_vname), tcobc ) 
     174                     llnot_done = .FALSE. 
     175                  ENDIF 
     176                  CALL iom_close (id_n) 
    151177               ENDIF 
    152             ENDIF 
    153             IF( lp_obc_south )   THEN 
    154                CALL flioopfd ('obcsouth_TS.nc',fid_s) 
    155                CALL flioinqv (fid_s,TRIM(v_name),l_exv,len_dims=f_d)  
    156                IF( l_exv )   THEN 
    157                   itobcs = f_d(1) 
    158                ELSE 
    159                   WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obcsouth_TS.nc' 
     178               IF ( lp_obc_south ) THEN 
     179                  IF ( llnot_done ) THEN 
     180                     CALL iom_gettime ( id_s, TRIM(cl_vname), tcobc ) 
     181                     llnot_done = .FALSE. 
     182                  ENDIF 
     183                  CALL iom_close (id_s) 
    160184               ENDIF 
    161             ENDIF 
    162  
    163             itobc = MAX(itobce,itobcw,itobcn,itobcs) 
    164             nstop = 0 
    165             IF( lp_obc_east  .AND. itobce /= itobc ) nstop = nstop+1  
    166             IF( lp_obc_west  .AND. itobcw /= itobc ) nstop = nstop+1       
    167             IF( lp_obc_north .AND. itobcn /= itobc ) nstop = nstop+1 
    168             IF( lp_obc_south .AND. itobcs /= itobc ) nstop = nstop+1  
    169             IF( nstop /= 0 )  THEN 
    170                IF( lwp )   THEN 
    171                   WRITE(numout,*) ' obcdta : all files must have the same number of time steps' 
    172                   WRITE(numout,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs 
    173                ENDIF 
    174                STOP 
    175             ENDIF 
    176             IF( itobc == 1 )   THEN 
    177                IF( lwp ) WRITE(numout,*) ' obcdta found one time step only in the OBC files' 
    178             ELSE 
    179                ALLOCATE (ztcobc(itobc)) 
    180                l_exv = .TRUE. 
    181                IF( lp_obc_east )   THEN 
    182                   IF( l_exv )   THEN 
    183                      CALL fliogetv (fid_e,TRIM(v_name),ztcobc) 
    184                      l_exv = .FALSE. 
    185                   ENDIF 
    186                   CALL flioclo (fid_e) 
    187                ENDIF 
    188                IF( lp_obc_west )   THEN 
    189                  IF( l_exv )   THEN 
    190                     CALL fliogetv (fid_w,TRIM(v_name),ztcobc) 
    191                     l_exv = .FALSE. 
    192                  ENDIF 
    193                  CALL flioclo (fid_w) 
    194                ENDIF 
    195                IF( lp_obc_north )   THEN 
    196                  IF( l_exv )   THEN 
    197                     CALL fliogetv (fid_n,TRIM(v_name),ztcobc) 
    198                     l_exv = .FALSE. 
    199                  ENDIF 
    200                  CALL flioclo (fid_n) 
    201                ENDIF 
    202                IF( lp_obc_south )   THEN 
    203                  IF( l_exv )   THEN 
    204                     CALL fliogetv (fid_s,TRIM(v_name),ztcobc) 
    205                     l_exv = .FALSE. 
    206                  ENDIF 
    207                  CALL flioclo (fid_s) 
    208                ENDIF 
    209                IF( lwp ) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files' 
    210                IF( .NOT. ln_obc_clim .AND. itobc == 12 )   THEN 
     185               IF ( lwp ) WRITE(numout,*) ' obcdta found', ntobc,' time steps in the OBC files' 
     186               IF ( .NOT. ln_obc_clim .AND. ntobc == 12 ) THEN 
    211187                  IF ( lwp ) WRITE(numout,*) '  WARNING: With monthly data we assume climatology' 
    212188                  ln_obc_clim = .true. 
    … …  
    332308         zxy   = 0 
    333309      ELSE 
    334          IF( itobc == 1 )   THEN 
     310         IF( ntobc == 1 )   THEN 
    335311            itimo = 1 
    336          ELSE IF( itobc == 12 )   THEN      !   BC are monthly    
     312         ELSE IF( ntobc == 12 )   THEN      !   BC are monthly    
    337313            ! we assume we have climatology in that case 
    338314            iman  = 12 
    … …  
    342318            itimo = imois    
    343319         ELSE 
    344             IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 
    345             iman  = itobc 
    346             itimo = FLOOR( kt*rdt / (ztcobc(2)-ztcobc(1)) ) 
     320            IF(lwp) WRITE(numout,*) 'data other than constant or monthly', kt 
     321            iman  = ntobc 
     322            itimo = FLOOR( kt*rdt / (tcobc(2)-tcobc(1)) ) 
    347323            isrel = kt*rdt 
    348324         ENDIF 
    … …  
    355331       
    356332         ! Calendar computation 
    357          IF( itobc == 1 )   THEN            !  BC are constant in time 
     333         IF( ntobc == 1 )   THEN            !  BC are constant in time 
    358334            ntobc1 = 1 
    359335            ntobc2 = 1   
    360          ELSE IF( itobc == 12 )   THEN      !   BC are monthly    
     336         ELSE IF( ntobc == 12 )   THEN      !   BC are monthly    
    361337            ntobc1 = itimo         ! first file record used 
    362338            ntobc2 = ntobc1 + 1    ! last  file record used 
    … …  
    386362            ! ... Read datafile and set temperature, salinity and normal velocity 
    387363            ! ... initialise the sedta, tedta, uedta arrays 
    388             CALL flioopfd ('obceast_TS.nc',fid_e) 
    389             CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc1,pdta_3D=sedta(:,:,1)) 
    390             CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc2,pdta_3D=sedta(:,:,2)) 
    391             CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc1,pdta_3D=tedta(:,:,1)) 
    392             CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc2,pdta_3D=tedta(:,:,2)) 
    393             CALL flioclo (fid_e)                                                            
    394                                                                                             
    395             CALL flioopfd ('obceast_U.nc',fid_e)                                            
    396             CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc1,pdta_3D=uedta(:,:,1)) 
    397             CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc2,pdta_3D=uedta(:,:,2)) 
    398             CALL flioclo (fid_e) 
     364            CALL iom_open ( 'obceast_TS.nc' , id_e ) 
     365            CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(:,:,1), ktime=ntobc1 ) 
     366            CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(:,:,2), ktime=ntobc2 ) 
     367            CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(:,:,1), ktime=ntobc1 ) 
     368            CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(:,:,2), ktime=ntobc2 ) 
     369            CALL iom_close (id_e) 
     370            ! 
     371            CALL iom_open ( 'obceast_U.nc' , id_e ) 
     372            CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(:,:,1), ktime=ntobc1 ) 
     373            CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(:,:,2), ktime=ntobc2 ) 
     374            CALL iom_close ( id_e ) 
    399375            !  Usually printout is done only once at kt = nit000, 
    400376            !  unless nprint (namelist) > 1       
    … …  
    402378               WRITE(numout,*) 
    403379               WRITE(numout,*) ' Read East OBC data records ', ntobc1, ntobc2 
    404                ikprint = (jpjef-jpjed+1)/20 +1 
     380               iprint = (jpjef-jpjed+1)/20 +1 
    405381               WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 
    406                CALL prihre( tedta(:,:,1),jpjef-jpjed+1,jpk,1,jpjef-jpjed+1,ikprint, & 
     382               CALL prihre( tedta(:,:,1),jpjef-jpjed+1,jpk,1,jpjef-jpjed+1,iprint, & 
    407383                  &         jpk, 1, -3, 1., numout ) 
    408384               WRITE(numout,*) 
    409385               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    410                CALL prihre( sedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, ikprint, & 
     386               CALL prihre( sedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, iprint, & 
    411387                  &        jpk, 1, -3, 1., numout ) 
    412388               WRITE(numout,*) 
    413389               WRITE(numout,*) ' Normal velocity U  record 1  - printout every 3 level' 
    414                CALL prihre( uedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, ikprint, & 
     390               CALL prihre( uedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, iprint, & 
    415391                  &         jpk, 1, -3, 1., numout ) 
    416392            ENDIF 
    … …  
    420396            ! ... Read datafile and set temperature, salinity and normal velocity 
    421397            ! ... initialise the swdta, twdta, uwdta arrays 
    422             CALL flioopfd ('obcwest_TS.nc',fid_w) 
    423             CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc1,pdta_3D=swdta(:,:,1)) 
    424             CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc2,pdta_3D=swdta(:,:,2)) 
    425             CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc1,pdta_3D=twdta(:,:,1)) 
    426             CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc2,pdta_3D=twdta(:,:,2)) 
    427             CALL flioclo (fid_w)                                                            
    428                                                                                             
    429             CALL flioopfd ('obcwest_U.nc',fid_w)                                            
    430             CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc1,pdta_3D=uwdta(:,:,1)) 
    431             CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc2,pdta_3D=uwdta(:,:,2)) 
    432             CALL flioclo (fid_w) 
    433  
     398            CALL iom_open ( 'obcwest_TS.nc' , id_w ) 
     399            CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(:,:,1), ktime=ntobc1 ) 
     400            CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(:,:,2), ktime=ntobc2 ) 
     401            CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(:,:,1), ktime=ntobc1 ) 
     402            CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(:,:,2), ktime=ntobc2 ) 
     403            CALL iom_close (id_w) 
     404            ! 
     405            CALL iom_open ( 'obcwest_U.nc' , id_w ) 
     406            CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(:,:,1), ktime=ntobc1 ) 
     407            CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(:,:,2), ktime=ntobc2 ) 
     408            CALL iom_close ( id_w ) 
     409            ! 
    434410            IF( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 ) )   THEN 
    435411               WRITE(numout,*) 
    436412               WRITE(numout,*) ' Read West OBC data records ', ntobc1, ntobc2 
    437                ikprint = (jpjwf-jpjwd+1)/20 +1 
     413               iprint = (jpjwf-jpjwd+1)/20 +1 
    438414               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    439                CALL prihre( twdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, ikprint, & 
     415               CALL prihre( twdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, iprint, & 
    440416                  &         jpk, 1, -3, 1., numout ) 
    441417               WRITE(numout,*) 
    442418               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    443                CALL prihre( swdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, ikprint, & 
     419               CALL prihre( swdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, iprint, & 
    444420                  &         jpk, 1, -3, 1., numout ) 
    445421               WRITE(numout,*) 
    446422               WRITE(numout,*) ' Normal velocity U  record 1  - printout every 3 level' 
    447                CALL prihre( uwdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, ikprint, & 
     423               CALL prihre( uwdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, iprint, & 
    448424                  &         jpk, 1, -3, 1., numout ) 
    449425            ENDIF 
    … …  
    451427 
    452428         IF( lp_obc_north )   THEN       
    453             CALL flioopfd ('obcnorth_TS.nc',fid_n) 
    454             CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc1,pdta_3D=sndta(:,:,1)) 
    455             CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc2,pdta_3D=sndta(:,:,2)) 
    456             CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc1,pdta_3D=tndta(:,:,1)) 
    457             CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc2,pdta_3D=tndta(:,:,2)) 
    458             CALL flioclo (fid_n)                                                            
    459                                                                                             
    460             CALL flioopfd ('obcnorth_V.nc',fid_n)                                           
    461             CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc1,pdta_3D=vndta(:,:,1)) 
    462             CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc2,pdta_3D=vndta(:,:,2)) 
    463             CALL flioclo (fid_n) 
    464  
     429            CALL iom_open ( 'obcnorth_TS.nc', id_n ) 
     430            CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(:,:,1), ktime=ntobc1 ) 
     431            CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(:,:,2), ktime=ntobc2 ) 
     432            CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(:,:,1), ktime=ntobc1 ) 
     433            CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(:,:,2), ktime=ntobc2 ) 
     434            CALL iom_close ( id_n )                                                            
     435            ! 
     436            CALL iom_open ( 'obcnorth_V.nc', id_n )                                           
     437            CALL iom_get ( id_n, jpdom_unknown, 'vomecrty', vndta(:,:,1), ktime=ntobc1 ) 
     438            CALL iom_get ( id_n, jpdom_unknown ,'vomecrty', vndta(:,:,2), ktime=ntobc2 ) 
     439            CALL iom_close ( id_n ) 
     440            ! 
    465441            IF( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 ) )   THEN 
    466442               WRITE(numout,*) 
    467443               WRITE(numout,*) ' Read North OBC data records ', ntobc1, ntobc2 
    468                ikprint = (jpinf-jpind+1)/20 +1 
     444               iprint = (jpinf-jpind+1)/20 +1 
    469445               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    470                CALL prihre( tndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, ikprint, & 
     446               CALL prihre( tndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, iprint, & 
    471447                  &         jpk, 1, -3, 1., numout ) 
    472448               WRITE(numout,*) 
    473449               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    474                CALL prihre( sndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, ikprint, & 
     450               CALL prihre( sndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, iprint, & 
    475451                  &         jpk, 1, -3, 1., numout ) 
    476452               WRITE(numout,*) 
    477453               WRITE(numout,*) ' Normal velocity V  record 1  - printout every 3 level' 
    478                CALL prihre( vndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, ikprint, & 
     454               CALL prihre( vndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, iprint, & 
    479455                  &         jpk, 1, -3, 1., numout ) 
    480456            ENDIF 
    … …  
    482458 
    483459         IF( lp_obc_south )   THEN       
    484             CALL flioopfd ('obcsouth_TS.nc',fid_s) 
    485             CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc1,pdta_3D=ssdta(:,:,1)) 
    486             CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc2,pdta_3D=ssdta(:,:,2)) 
    487             CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc1,pdta_3D=tsdta(:,:,1)) 
    488             CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc2,pdta_3D=tsdta(:,:,2)) 
    489             CALL flioclo (fid_s)                                                            
    490                                                                                             
    491             CALL flioopfd ('obcsouth_V.nc',fid_s)                                           
    492             CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc1,pdta_3D=vsdta(:,:,1)) 
    493             CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc2,pdta_3D=vsdta(:,:,2)) 
    494             CALL flioclo (fid_s) 
    495  
     460            CALL iom_open ( 'obcsouth_TS.nc', id_s ) 
     461            CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(:,:,1), ktime=ntobc1 ) 
     462            CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(:,:,2), ktime=ntobc2 ) 
     463            CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(:,:,1), ktime=ntobc1 ) 
     464            CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(:,:,2), ktime=ntobc2 ) 
     465            CALL iom_close ( id_s )                                                            
     466            ! 
     467            CALL iom_open ( 'obcsouth_V.nc', id_s )                                           
     468            CALL iom_get ( id_s, jpdom_unknown, 'vomecrty', vsdta(:,:,1), ktime=ntobc1 ) 
     469            CALL iom_get ( id_s, jpdom_unknown ,'vomecrty', vsdta(:,:,2), ktime=ntobc2 ) 
     470            CALL iom_close ( id_s ) 
     471            ! 
    496472            IF( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 ) )   THEN 
    497473               WRITE(numout,*) 
    498474               WRITE(numout,*) ' Read South OBC data records ', ntobc1, ntobc2 
    499                ikprint = (jpisf-jpisd+1)/20 +1 
     475               iprint = (jpisf-jpisd+1)/20 +1 
    500476               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level' 
    501                CALL prihre( tsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, ikprint, & 
     477               CALL prihre( tsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, iprint, & 
    502478                  &         jpk, 1, -3, 1., numout ) 
    503479               WRITE(numout,*) 
    504480               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level' 
    505                CALL prihre( ssdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, ikprint, & 
     481               CALL prihre( ssdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, iprint, & 
    506482                  &         jpk, 1, -3, 1., numout ) 
    507483               WRITE(numout,*) 
    508484               WRITE(numout,*) ' Normal velocity V  record 1  - printout every 3 level' 
    509                CALL prihre( vsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, ikprint, & 
     485               CALL prihre( vsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, iprint, & 
    510486                  &         jpk, 1, -3, 1., numout ) 
    511487            ENDIF 
    … …  
    522498      ! ---------------------------------------------------- 
    523499 
    524       IF( itobc == 1 .OR. nobc_dta == 0 )   THEN  
     500      IF( ntobc == 1 .OR. nobc_dta == 0 )   THEN  
    525501         zxy = 0. 
    526       ELSE IF( itobc == 12 )   THEN          
     502      ELSE IF( ntobc == 12 )   THEN          
    527503         zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    528504      ELSE 
    529          zxy = (ztcobc(ntobc1)-FLOAT(isrel))/(ztcobc(ntobc1)-ztcobc(ntobc2)) 
     505         zxy = (tcobc(ntobc1)-FLOAT(isrel))/(tcobc(ntobc1)-tcobc(ntobc2)) 
    530506      ENDIF 
    531507       
    … …  
    793769      !! * Local declarations 
    794770      INTEGER ::   ji, jj, jk, ii, ij   ! dummy loop indices 
    795       INTEGER ::   fid_e, fid_w, fid_n, fid_s, fid  ! file identifiers 
     771      INTEGER ::   id_e, id_w, id_n, id_s, fid  ! file identifiers 
    796772      INTEGER ::   itimo, iman, imois, i15 
    797       INTEGER ::   ntobcm, ntobcp, itimom, itimop 
     773      INTEGER ::   itobcm, itobcp, itimom, itimop 
    798774      REAL(wp) ::  zxy 
    799775      INTEGER ::   isrel, ikt           ! number of seconds since 1/1/1992 
    800       INTEGER ::   ikprint              ! frequency for printouts. 
     776      INTEGER ::   iprint              ! frequency for printouts. 
    801777 
    802778      !!--------------------------------------------------------------------------- 
    … …  
    909885         zxy   = 0 
    910886      ELSE 
    911          IF(itobc == 1) THEN 
     887         IF(ntobc == 1) THEN 
    912888            itimo = 1 
    913          ELSE IF (itobc == 12) THEN      !   BC are monthly 
     889         ELSE IF (ntobc == 12) THEN      !   BC are monthly 
    914890            ! we assume we have climatology in that case 
    915891            iman  = 12 
    … …  
    920896         ELSE 
    921897            IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 
    922             iman  = itobc 
    923             itimo = FLOOR( kt*rdt / ztcobc(1)) 
     898            iman  = ntobc 
     899            itimo = FLOOR( kt*rdt / tcobc(1)) 
    924900            isrel=kt*rdt 
    925901         ENDIF 
    … …  
    936912            sshedta(:,0) = sshedta(:,1) 
    937913            ubtedta(:,0) = ubtedta(:,1) 
    938             CALL flioopfd ('obceast_TS.nc',fid_e) 
    939             CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc1,pdta_2D=sshedta(:,1)) 
    940             CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2,pdta_2D=sshedta(:,2)) 
     914            CALL iom_open ( 'obceast_TS.nc', id_e ) 
     915            CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,1), ktime=ntobc1 ) 
     916            CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,2), ktime=ntobc2 ) 
    941917            IF( lk_dynspg_ts ) THEN 
    942                CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2+1,pdta_2D=sshedta(:,3)) 
    943             ENDIF 
    944             CALL flioclo (fid_e) 
    945  
    946             CALL flioopfd ('obceast_U.nc',fid_e) 
    947             CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc1,pdta_2D=ubtedta(:,1)) 
    948             CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2,pdta_2D=ubtedta(:,2)) 
     918               CALL iom_get (id_e, jpdom_unknown, 'vossurfh', sshedta(:,3), ktime=ntobc2+1 ) 
     919            ENDIF 
     920            CALL iom_close ( id_e ) 
     921            ! 
     922            CALL iom_open ( 'obceast_U.nc', id_e ) 
     923            CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,1), ktime=ntobc1 ) 
     924            CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,2), ktime=ntobc2 ) 
    949925            IF( lk_dynspg_ts ) THEN 
    950                CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2+1,pdta_2D=ubtedta(:,3)) 
    951             ENDIF 
    952             CALL flioclo (fid_e) 
    953  
     926               CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,3), ktime=ntobc2+1 ) 
     927            ENDIF 
     928            CALL iom_close ( id_e ) 
    954929            ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 
    955930            IF( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN 
    956931               WRITE(numout,*) 
    957932               WRITE(numout,*) ' Read East OBC barotropic data records ', ntobc1, ntobc2 
    958                ikprint = (jpjef-jpjed+1)/20 +1 
     933               iprint = (jpjef-jpjed+1)/20 +1 
    959934               WRITE(numout,*) 
    960935               WRITE(numout,*) ' Sea surface height record 1' 
    961                CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, ikprint, 1, 1, -3, 1., numout ) 
    962                WRITE(numout,*) 
    963                WRITE(numout,*) ' Normal transport (m2/s) record 1',ikprint 
    964                CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, ikprint, 1, 1, -3, 1., numout ) 
     936               CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout ) 
     937               WRITE(numout,*) 
     938               WRITE(numout,*) ' Normal transport (m2/s) record 1',iprint 
     939               CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout ) 
    965940            ENDIF 
    966941         ENDIF 
    … …  
    971946            sshwdta(:,0) = sshwdta(:,1) 
    972947            ubtwdta(:,0) = ubtwdta(:,1) 
    973             CALL flioopfd ('obcwest_TS.nc',fid_w) 
    974             CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc1,pdta_2D=sshwdta(:,1)) 
    975             CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2,pdta_2D=sshwdta(:,2)) 
     948            CALL iom_open ( 'obcwest_TS.nc', id_w ) 
     949            CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,1), ktime=ntobc1 ) 
     950            CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,2), ktime=ntobc2 ) 
    976951            IF( lk_dynspg_ts ) THEN 
    977                CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=sshwdta(:,3)) 
    978             ENDIF 
    979             CALL flioclo (fid_w) 
    980  
    981             CALL flioopfd ('obcwest_U.nc',fid_w) 
    982             CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc1,pdta_2D=ubtwdta(:,1)) 
    983             CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2,pdta_2D=ubtwdta(:,2)) 
     952               CALL  ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,3), ktime=ntobc2+1 ) 
     953            ENDIF 
     954            CALL iom_close ( id_w ) 
     955            ! 
     956            CALL iom_open ( 'obcwest_U.nc', id_w ) 
     957            CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,1), ktime=ntobc1 ) 
     958            CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,2), ktime=ntobc2 ) 
    984959            IF( lk_dynspg_ts ) THEN 
    985                CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=ubtwdta(:,3)) 
    986             ENDIF 
    987             CALL flioclo (fid_w) 
    988  
     960               CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,3), ktime=ntobc2+1 ) 
     961            ENDIF 
     962            CALL iom_close ( id_w ) 
    989963            ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 
    990964            IF( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN 
    991965               WRITE(numout,*) 
    992966               WRITE(numout,*) ' Read West OBC barotropic data records ', ntobc1, ntobc2 
    993                ikprint = (jpjwf-jpjwd+1)/20 +1 
     967               iprint = (jpjwf-jpjwd+1)/20 +1 
    994968               WRITE(numout,*) 
    995969               WRITE(numout,*) ' Sea surface height record 1  - printout surface level' 
    996                CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, ikprint, 1, 1, -3, 1., numout ) 
     970               CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout ) 
    997971               WRITE(numout,*) 
    998972               WRITE(numout,*) ' Normal transport (m2/s) record 1' 
    999                CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, ikprint, 1, 1, -3, 1., numout ) 
     973               CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout ) 
    1000974            ENDIF 
    1001975         ENDIF 
    … …  
    1006980            sshndta(:,0) = sshndta(:,1) 
    1007981            vbtndta(:,0) = vbtndta(:,1) 
    1008             CALL flioopfd ('obcnorth_TS.nc',fid_n) 
    1009             CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc1,pdta_2D=sshndta(:,1)) 
    1010             CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2,pdta_2D=sshndta(:,2)) 
     982            CALL iom_open ( 'obcnorth_TS.nc', id_n ) 
     983            CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,1), ktime=ntobc1 ) 
     984            CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,2), ktime=ntobc2 ) 
    1011985            IF( lk_dynspg_ts ) THEN 
    1012                CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2+1,pdta_2D=sshndta(:,3)) 
    1013             ENDIF 
    1014             CALL flioclo (fid_n) 
    1015  
    1016             CALL flioopfd ('obcnorth_V.nc',fid_n) 
    1017             CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc1,pdta_2D=vbtndta(:,1)) 
    1018             CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2,pdta_2D=vbtndta(:,2)) 
     986               CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,3), ktime=ntobc2+1 ) 
     987            ENDIF 
     988            CALL iom_close ( id_n ) 
     989 
     990            CALL iom_open ( 'obcnorth_V.nc', id_n ) 
     991            CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,1), ktime=ntobc1 ) 
     992            CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,2), ktime=ntobc2 ) 
    1019993            IF( lk_dynspg_ts ) THEN 
    1020                CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2+1,pdta_2D=vbtndta(:,3)) 
    1021             ENDIF 
    1022             CALL flioclo (fid_n) 
     994               CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,3), ktime=ntobc2+1 ) 
     995            ENDIF 
     996            CALL iom_close ( id_n ) 
    1023997 
    1024998            ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 
    … …  
    10261000               WRITE(numout,*) 
    10271001               WRITE(numout,*) ' Read North OBC barotropic data records ', ntobc1, ntobc2 
    1028                ikprint = (jpinf-jpind+1)/20 +1 
     1002               iprint = (jpinf-jpind+1)/20 +1 
    10291003               WRITE(numout,*) 
    10301004               WRITE(numout,*) ' Sea surface height record 1  - printout surface level' 
    1031                CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, ikprint, 1, 1, -3, 1., numout ) 
     1005               CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout ) 
    10321006               WRITE(numout,*) 
    10331007               WRITE(numout,*) ' Normal transport (m2/s) record 1' 
    1034                CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, ikprint, 1, 1, -3, 1., numout ) 
     1008               CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout ) 
    10351009            ENDIF 
    10361010         ENDIF 
    … …  
    10411015            sshsdta(:,0) = sshsdta(:,1) 
    10421016            vbtsdta(:,0) = vbtsdta(:,1) 
    1043             CALL flioopfd ('obcsouth_TS.nc',fid_s) 
    1044             CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc1,pdta_2D=sshsdta(:,1)) 
    1045             CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2,pdta_2D=sshsdta(:,2)) 
     1017            CALL iom_open ( 'obcsouth_TS.nc', id_s ) 
     1018            CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,1), ktime=ntobc1 ) 
     1019            CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,2), ktime=ntobc2 ) 
    10461020            IF( lk_dynspg_ts ) THEN 
    1047                CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2+1,pdta_2D=sshsdta(:,3)) 
    1048             ENDIF 
    1049             CALL flioclo (fid_s) 
    1050  
    1051             CALL flioopfd ('obcsouth_V.nc',fid_s) 
    1052             CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc1,pdta_2D=vbtsdta(:,1)) 
    1053             CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2,pdta_2D=vbtsdta(:,2)) 
     1021               CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,3), ktime=ntobc2+1 ) 
     1022            ENDIF 
     1023            CALL iom_close ( id_s ) 
     1024 
     1025            CALL iom_open ( 'obcsouth_V.nc', id_s ) 
     1026            CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,1), ktime=ntobc1 ) 
     1027            CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,2), ktime=ntobc2 ) 
    10541028            IF( lk_dynspg_ts ) THEN 
    1055                CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2+1,pdta_2D=vbtsdta(:,3)) 
    1056             ENDIF 
    1057             CALL flioclo (fid_s) 
     1029               CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,3), ktime=ntobc2+1 ) 
     1030            ENDIF 
     1031            CALL iom_close ( id_s ) 
    10581032                 
    10591033            ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 
    … …  
    10611035               WRITE(numout,*) 
    10621036               WRITE(numout,*) ' Read South OBC barotropic data records ', ntobc1, ntobc2 
    1063                ikprint = (jpisf-jpisd+1)/20 +1 
     1037               iprint = (jpisf-jpisd+1)/20 +1 
    10641038               WRITE(numout,*) 
    10651039               WRITE(numout,*) ' Sea surface height record 1  - printout surface level' 
    1066                CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, ikprint, 1, 1, -3, 1., numout ) 
     1040               CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout ) 
    10671041               WRITE(numout,*) 
    10681042               WRITE(numout,*) ' Normal transport (m2/s) record 1' 
    1069                CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, ikprint, 1, 1, -3, 1., numout ) 
     1043               CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout ) 
    10701044            ENDIF 
    10711045         ENDIF 
    … …  
    10811055          IF( nobc_dta == 1 ) THEN 
    10821056             isrel = (kt-1)*rdt + kbt*rdtbt 
    1083              itimo  = FLOOR(  kt*rdt    / (ztcobc(2)-ztcobc(1)) ) 
    1084              itimom = FLOOR( (kt-1)*rdt / (ztcobc(2)-ztcobc(1)) ) 
    1085              itimop = FLOOR( (kt+1)*rdt / (ztcobc(2)-ztcobc(1)) ) 
     1057             itimo  = FLOOR(  kt*rdt    / (tcobc(2)-tcobc(1)) ) 
     1058             itimom = FLOOR( (kt-1)*rdt / (tcobc(2)-tcobc(1)) ) 
     1059             itimop = FLOOR( (kt+1)*rdt / (tcobc(2)-tcobc(1)) ) 
    10861060             IF( itimom == itimo .AND. itimop == itimo ) THEN 
    1087                 ntobcm = ntobc1 
    1088                 ntobcp = ntobc2 
     1061                itobcm = ntobc1 
     1062                itobcp = ntobc2 
    10891063 
    10901064             ELSEIF ( itimom <= itimo .AND. itimop == itimo ) THEN 
    1091                 IF(  FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimo ) THEN 
    1092                    ntobcm = ntobc1-1 
    1093                    ntobcp = ntobc2-1 
     1065                IF(  FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN 
     1066                   itobcm = ntobc1-1 
     1067                   itobcp = ntobc2-1 
    10941068                ELSE 
    1095                    ntobcm = ntobc1 
    1096                    ntobcp = ntobc2 
     1069                   itobcm = ntobc1 
     1070                   itobcp = ntobc2 
    10971071                ENDIF 
    10981072 
    10991073             ELSEIF ( itimom == itimo .AND. itimop >= itimo ) THEN 
    1100                 IF(  FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimop ) THEN 
    1101                    ntobcm = ntobc1 
    1102                    ntobcp = ntobc2 
     1074                IF(  FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN 
     1075                   itobcm = ntobc1 
     1076                   itobcp = ntobc2 
    11031077                ELSE 
    1104                    ntobcm = ntobc1+1 
    1105                    ntobcp = ntobc2+1 
     1078                   itobcm = ntobc1+1 
     1079                   itobcp = ntobc2+1 
    11061080                ENDIF 
    11071081 
    11081082             ELSEIF ( itimom == itimo-1 .AND. itimop == itimo+1 ) THEN 
    1109                 IF(  FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimo ) THEN 
    1110                    ntobcm = ntobc1-1 
    1111                    ntobcp = ntobc2-1 
    1112                 ELSEIF (  FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimop ) THEN 
    1113                    ntobcm = ntobc1 
    1114                    ntobcp = ntobc2 
    1115                 ELSEIF (  FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) == itimop ) THEN 
    1116                    ntobcm = ntobc1+1 
    1117                    ntobcp = ntobc2+2 
     1083                IF(  FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN 
     1084                   itobcm = ntobc1-1 
     1085                   itobcp = ntobc2-1 
     1086                ELSEIF (  FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN 
     1087                   itobcm = ntobc1 
     1088                   itobcp = ntobc2 
     1089                ELSEIF (  FLOOR( isrel / (tcobc(2)-tcobc(1)) ) == itimop ) THEN 
     1090                   itobcm = ntobc1+1 
     1091                   itobcp = ntobc2+2 
    11181092                ELSE 
    11191093                   IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 1?' 
    … …  
    11271101       ELSE IF( lk_dynspg_exp ) THEN 
    11281102          isrel=kt*rdt 
    1129           ntobcm = ntobc1 
    1130           ntobcp = ntobc2 
     1103          itobcm = ntobc1 
     1104          itobcp = ntobc2 
    11311105       ENDIF 
    11321106 
    1133        IF( itobc == 1 .OR. nobc_dta == 0 ) THEN 
     1107       IF( ntobc == 1 .OR. nobc_dta == 0 ) THEN 
    11341108          zxy = 0.e0 
    1135        ELSE IF( itobc == 12 ) THEN 
     1109       ELSE IF( ntobc == 12 ) THEN 
    11361110          zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    11371111       ELSE 
    1138           zxy = (ztcobc(ntobcm)-FLOAT(isrel)) / (ztcobc(ntobcm)-ztcobc(ntobcp)) 
     1112          zxy = (tcobc(itobcm)-FLOAT(isrel)) / (tcobc(itobcm)-tcobc(itobcp)) 
    11391113       ENDIF 
    11401114 
    … …  
    11771151   !!   Default option 
    11781152   !!----------------------------------------------------------------------------- 
    1179    SUBROUTINE obc_dta_bt( kt, kbt )       ! Empty routine 
    1180       INTEGER,INTENT(in) ::   kt, kbt 
    1181       WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt, kbt 
     1153   SUBROUTINE obc_dta_bt ( kt, kbt )       ! Empty routine 
     1154      !! * Arguments 
     1155      INTEGER,INTENT(in) :: kt 
     1156      INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index 
     1157      WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 
     1158      WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 
    11821159   END SUBROUTINE obc_dta_bt 
    11831160#endif 
    1184  
    1185  
    1186    SUBROUTINE obc_dta_gv (ifid,cldim,clobc,kobcij,ktobc,pdta_2D,pdta_3D) 
    1187       !!----------------------------------------------------------------------------- 
    1188       !!                       ***  SUBROUTINE obc_dta_gv  *** 
    1189       !! 
    1190       !! ** Purpose :   Read an OBC forcing field from netcdf file  
    1191       !!                Input file are supposed to be 3D e.g. 
    1192       !!                - for a South or North OB : longitude x depth x time 
    1193       !!    - for a West or East OB : latitude x depth x time 
    1194       !! 
    1195       !! History : 
    1196       !!        !  04-06 (A.-M. Treguier, F. Durand) Original code 
    1197       !!        !  05-02 (J. Bellier, C. Talandier) use fliocom CALL 
    1198       !!---------------------------------------------------------------------------- 
    1199       !! * Arguments 
    1200       INTEGER, INTENT(IN) ::   & 
    1201          ifid  ,               & ! netcdf file name identifier 
    1202          kobcij,               & ! Horizontal (i or j) dimension of the array 
    1203          ktobc                   ! starting time index read 
    1204       CHARACTER(LEN=*), INTENT(IN)    ::   & 
    1205          cldim,                & ! dimension along which is the open boundary ('x' or 'y') 
    1206          clobc                   ! name of the netcdf variable read 
    1207       REAL, DIMENSION(kobcij,jpk,1), INTENT(OUT), OPTIONAL ::   & 
    1208          pdta_3D                 ! 3D array of OBC forcing field 
    1209       REAL, DIMENSION(kobcij,1), INTENT(OUT), OPTIONAL ::   & 
    1210          pdta_2D                 ! 3D array of OBC forcing field 
    1211        
    1212       !! * Local declarations 
    1213       INTEGER ::   indim 
    1214       LOGICAL ::   l_exv 
    1215       INTEGER,DIMENSION(4) ::   f_d, istart, icount 
    1216       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   v_tmp_4 
    1217       !---------------------------------------------------------------------- 
    1218  
    1219       CALL flioinqv (ifid,TRIM(clobc),l_exv,nb_dims=indim,len_dims=f_d)  
    1220       IF( l_exv )   THEN 
    1221          ! checks the number of dimensions 
    1222          IF( indim == 2 )   THEN 
    1223             istart(1:2) = (/ 1     , ktobc /) 
    1224             icount(1:2) = (/ kobcij, 1     /) 
    1225             CALL fliogetv (ifid,TRIM(clobc),pdta_2D,start=istart(1:2),count=icount(1:2)) 
    1226          ELSE IF( indim == 3 )   THEN 
    1227             istart(1:3) = (/ 1     , 1    , ktobc /) 
    1228             icount(1:3) = (/ kobcij, jpk  , 1     /) 
    1229             CALL fliogetv (ifid,TRIM(clobc),pdta_3D,start=istart(1:3),count=icount(1:3)) 
    1230          ELSE IF( indim == 4 )   THEN 
    1231             istart(1:4) = (/ 1, 1, 1, ktobc /) 
    1232             IF( TRIM(cldim) == 'y' )   THEN 
    1233                icount(1:4) = (/ 1     , kobcij, jpk  , 1 /) 
    1234             ELSE 
    1235                icount(1:4) = (/ kobcij, 1     , jpk  , 1 /) 
    1236             ENDIF 
    1237             ALLOCATE (v_tmp_4(icount(1),icount(2),icount(3),icount(4))) 
    1238             CALL fliogetv (ifid,TRIM(clobc),v_tmp_4,start=istart(1:4),count=icount(1:4)) 
    1239             IF( TRIM(cldim) == 'y' )   THEN 
    1240                pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1,1:kobcij,1:jpk,1:1) 
    1241             ELSE 
    1242                pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1:kobcij,1,1:jpk,1:1) 
    1243             ENDIF 
    1244             DEALLOCATE (v_tmp_4) 
    1245          ELSE 
    1246             IF( lwp )   THEN 
    1247                WRITE(numout,*) ' Problem in OBC file for ',TRIM(clobc),' :' 
    1248                WRITE(numout,*) ' number of dimensions (not 3 or 4) =',indim 
    1249             ENDIF 
    1250             STOP 
    1251          ENDIF 
    1252       ELSE 
    1253          WRITE(numout,*) ' Variable ',TRIM(clobc),' not found' 
    1254       ENDIF 
    1255        
    1256    END SUBROUTINE obc_dta_gv 
    12571161 
    12581162#else 

  • trunk/NEMO/OPA_SRC/SBC/blk_oce.F90

    r298 r473  
    1111   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
     13#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
    1414   !!---------------------------------------------------------------------- 
    1515   !! ' key_flx_bulk_monthly or defined key_flx_bulk_daily             bulk 

  • trunk/NEMO/OPA_SRC/SBC/flx_bulk_daily.h90

    r444 r473  
    1414      numfl1, numfl2,  &  ! logical units for surface fluxes data 
    1515      numfl3, numfl4,  &  !  
    16       nflx1, nflx2,    &  !  first and second record used 
    17       nflx11, nflx12 , &  ! ??? 
     16      nflx1 , nflx2 ,  &  !  first and second record used 
    1817      ndayflx 
    1918 
    … …  
    5554      !!        !  92-07  (M. Imbard) 
    5655      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files 
    57       !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl 
     56      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with io-ipsl 
    5857      !!        !  00-05  (K. Rodgers) Daily Netcdf 
    5958      !!   8.5  !  02-09  (C. Ethe and G. Madec)  F90: Free form and MODULE  
    6059      !!---------------------------------------------------------------------- 
    6160      !! * modules used 
    62       USE ioipsl          ! NetCDF IPSL library 
     61      USE iom             ! I/O library 
    6362      USE blk_oce         ! bulk variable 
    6463      USE bulk            ! bulk module 
    … …  
    6867 
    6968      !! * Local declarations       
    70       INTEGER , PARAMETER :: jpday  = 365, jpmois = 12 
    71       INTEGER  ::   i15,iday, idy 
    72       INTEGER  ::   ipi,ipj,ipk 
    73       INTEGER  ::   iman,imois,imois2 
    74       INTEGER, DIMENSION(jpday) :: istep_n 
    75       INTEGER, DIMENSION(jpmois):: istep_c, istep_x 
    76       INTEGER  ::   itime 
    77       REAL(wp) ::   zdate0, zxy 
    78       REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat   ! ??? 
    79       REAL(wp), DIMENSION(jpk) ::   zlev           ! ??? 
    80       CHARACTER(len=45)  ::  & 
    81          clname_n ,        & 
    82          clname_c ,   & 
    83          clname_x ,        & 
    84          clname_w  
    85       !!--------------------------------------------------------------------- 
    86          clname_n = 'tair_1d.nc' 
    87          clname_c = 'hum_cloud_1m.nc' 
    88          clname_x = 'rain_1m.nc' 
    89          clname_w = 'wspd_1d.nc' 
     69      INTEGER  ::   iman,imois,i15 
     70      REAL(wp) ::   zxy 
    9071      !!--------------------------------------------------------------------- 
    9172 
    … …  
    9576 
    9677      i15 = INT(2*FLOAT(nday)/(FLOAT(nobis(nmonth))+0.5)) 
    97       itime = jpday 
    98       ipi = jpiglo 
    99       ipj = jpjglo 
    100       ipk = jpk 
    101       idy = 365 
    102       IF(nleapy == 1) idy = 366 
    103  
    104       iman = 12 
     78      iman  = INT( raamo ) 
    10579      imois = nmonth + i15 - 1 
    10680      IF (imois == 0) imois = iman 
    107       imois2 = nmonth 
    10881 
    10982 
    … …  
    11285       
    11386      IF( kt == nit000 ) THEN 
    114           
     87         ! initializations 
    11588         nflx1 = 0 
    116          nflx11 = 0 
    117           
     89         ndayflx = 0 
    11890         IF(lwp) THEN 
    11991            WRITE(numout,*) ' ' 
    120             WRITE(numout,*) ' **** Routine flx.forced.ncep_clio_xie.h90' 
    121             WRITE(numout,*) ' **** global NCEP flx  daily fields ' 
    122             WRITE(numout,*) ' **** global CLIO flx  monthly fields ' 
    123             WRITE(numout,*) ' **** global XIE  flx  monthly fields ' 
    124             WRITE(numout,*) ' --------------------------------' 
    125             WRITE(numout,*) ' NetCDF FORMAT' 
     92            WRITE(numout,*) ' **** Routine flx_bulk_daily.h90' 
    12693            WRITE(numout,*) ' ' 
    127          ENDIF 
    128  
    129 #if defined key_agrif 
    130       if ( .NOT. Agrif_Root() ) then 
    131          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname_n) 
    132       endif 
    133 #endif   
    134           
    135          ! open NCEP file 
    136           CALL flinopen(clname_n,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj & 
    137              ,ipk,zlon,zlat,zlev,itime,istep_n,zdate0,rdt,numfl1) 
    138  
    139           IF( itime /= jpday .AND. itime /= jpday+1 ) THEN 
    140              IF(lwp) THEN 
    141                 WRITE(numout,*) ' ' 
    142                 WRITE(numout,*) 'problem with time coordinates ' 
    143                 WRITE(numout,*) ' itime ',itime,' jpday ',jpday 
    144                 WRITE(numout,*) ' Check in file', clname_n 
    145              ENDIF 
    146              STOP 'flx_bulk_daily.h90' 
    147           ENDIF 
    148           IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN 
    149           IF(lwp) THEN 
    150              WRITE(numout,*) ' ' 
    151              WRITE(numout,*) 'problem with dimensions' 
    152              WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    153              WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    154              WRITE(numout,*) ' ipk ',ipk,' =? 1' 
    155              WRITE(numout,*) ' Check in file', clname_n 
    156           ENDIF 
    157           STOP 'flx_bulk_daily.h90' 
    158        ENDIF 
    159  
    160 #if defined key_agrif 
    161       if ( .NOT. Agrif_Root() ) then 
    162          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname_c) 
    163       endif 
    164 #endif   
    165  
    166        ! open CLIO file 
    167        CALL flinopen(clname_c,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj & 
    168           ,ipk,zlon,zlat,zlev,itime,istep_c,zdate0,rdt,numfl2) 
    169         
    170        IF( itime /= jpmois ) THEN 
    171           IF(lwp) THEN 
    172              WRITE(numout,*) ' ' 
    173              WRITE(numout,*) 'problem with time coordinates ' 
    174              WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    175              WRITE(numout,*) ' Check in file', clname_c 
    176           ENDIF 
    177           STOP 'flx_bulk_daily.h90' 
    178        ENDIF 
    179        IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN 
    180           IF(lwp) THEN 
    181              WRITE(numout,*) ' ' 
    182              WRITE(numout,*) 'problem with dimensions' 
    183              WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    184              WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    185              WRITE(numout,*) ' ipk ',ipk,' =? 1' 
    186              WRITE(numout,*) ' Check in file', clname_c 
    187           ENDIF 
    188           STOP 'flx_bulk_daily.h90' 
    189        ENDIF 
    190  
    191 #if defined key_agrif 
    192       if ( .NOT. Agrif_Root() ) then 
    193          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname_x) 
    194       endif 
    195 #endif   
    196         
    197        ! open CMAP FILE 
    198        CALL flinopen(clname_x,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj & 
    199           ,ipk,zlon,zlat,zlev,itime,istep_x,zdate0,rdt,numfl3) 
    200  
    201        IF( itime /= jpmois ) THEN 
    202           IF(lwp) THEN 
    203              WRITE(numout,*) ' ' 
    204              WRITE(numout,*) 'problem with time coordinates ' 
    205              WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    206              WRITE(numout,*) ' Check in file', clname_x 
    207           ENDIF 
    208           STOP 'flx_bulk_daily.h90' 
    209        ENDIF 
    210        IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN 
    211           IF(lwp) THEN 
    212              WRITE(numout,*) ' ' 
    213              WRITE(numout,*) 'problem with dimensions' 
    214              WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    215              WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    216              WRITE(numout,*) ' ipk ',ipk,' =? 1' 
    217              WRITE(numout,*) ' Check in file', clname_x 
    218           ENDIF 
    219           STOP 'flx_bulk_daily.h90' 
    220        ENDIF 
    221  
    222 #if defined key_agrif 
    223       if ( .NOT. Agrif_Root() ) then 
    224          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname_w) 
    225       endif 
    226 #endif   
    227  
    228        ! open ERS-NCEP file 
    229        CALL flinopen(clname_w,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj & 
    230              ,ipk,zlon,zlat,zlev,itime,istep_n,zdate0,rdt,numfl4) 
    231  
    232        IF( itime /= jpday .AND. itime /= jpday+1 ) THEN 
    233           IF(lwp) THEN 
    234              WRITE(numout,*) ' ' 
    235              WRITE(numout,*) 'problem with time coordinates ' 
    236              WRITE(numout,*) ' itime ',itime,' jpday ',jpday 
    237              WRITE(numout,*) ' Check in file', clname_w 
    238           ENDIF 
    239           STOP 'flx_bulk_daily.h90' 
    240        ENDIF 
    241        IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN 
    242           IF(lwp) THEN 
    243              WRITE(numout,*) ' ' 
    244              WRITE(numout,*) 'problem with dimensions' 
    245              WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    246              WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    247              WRITE(numout,*) ' ipk ',ipk,' =? 1' 
    248              WRITE(numout,*) ' Check in file', clname_w 
    249           ENDIF 
    250           STOP 'flx_bulk_daily.h90' 
    251        ENDIF 
    252  
    253     ENDIF 
     94         ENDIF          
     95         ! open files 
     96         IF(lwp) WRITE(numout,*) ' **** global NCEP flx  daily fields ' 
     97         CALL iom_open ( 'tair_1d.nc', numfl1 ) 
     98         IF(lwp) WRITE(numout,*) ' **** global CLIO flx  monthly fields ' 
     99         CALL iom_open ( 'hum_cloud_1m.nc', numfl2 ) 
     100         IF(lwp) WRITE(numout,*) ' **** global XIE  flx  monthly fields ' 
     101         CALL iom_open ( 'rain_1m.nc', numfl3 ) 
     102         IF(lwp) WRITE(numout,*) ' **** global ERS-NCEP  wind daily  fields ' 
     103         CALL iom_open ( 'wspd_1d.nc', numfl4 ) 
     104      ENDIF 
    254105 
    255106 
    256     ! 2. Read daily DATA Temperature from NCEP 
    257     ! --------------------------------------- 
     107      ! 2. Read daily DATA Temperature from NCEP 
     108      ! --------------------------------------- 
     109       
     110      IF( ndayflx /= nday ) THEN  
     111          
     112         ndayflx = nday 
     113          
     114         ! read T 2m (Caution in K) 
     115         CALL iom_get ( numfl1, jpdom_data, 'air', tatm, nday_year ) 
     116          
     117         IF(lwp) WRITE (numout,*)' Lecture daily flx record OK :',nday_year 
     118         IF(lwp) WRITE (numout,*)' ' 
     119          
     120         ! conversion of temperature Kelvin --> Celsius  [rt0=273.15] 
     121         tatm(:,:) = ( tatm(:,:) - rt0 )  
     122          
     123         ! read wind speed 
     124         CALL iom_get ( numfl4, jpdom_data, 'wspd', vatm, nday_year ) 
     125          
     126         IF(lwp) WRITE (numout,*)' Lecture daily wind speed flx :',nday_year 
     127         IF(lwp) WRITE (numout,*)' ' 
     128          
     129      ENDIF 
    258130 
    259     IF( ndayflx /= nday ) THEN  
    260  
    261        ndayflx = nday 
    262        iday    = nday_year 
    263  
    264        ! read T 2m (Caution in K) 
    265        CALL flinget(numfl1,'air',jpidta,jpjdta,1,jpday,iday, & 
    266           iday,mig(1),nlci,mjg(1),nlcj,tatm(1:nlci,1:nlcj)) 
    267  
    268        IF(lwp) WRITE (numout,*)' Lecture daily flx record OK :',iday 
    269        IF(lwp) WRITE (numout,*)' ' 
    270  
    271        ! conversion of temperature Kelvin --> Celsius  [rt0=273.15] 
    272        tatm(:,:) = ( tatm(:,:) - rt0 )  
    273  
    274        ! read wind speed 
    275        CALL flinget(numfl4,'wspd',jpidta,jpjdta,1,jpday,iday, & 
    276           iday,mig(1),nlci,mjg(1),nlcj,vatm(1:nlci,1:nlcj)) 
    277  
    278        IF(lwp) WRITE (numout,*)' Lecture daily wind speed flx :',iday 
    279        IF(lwp) WRITE (numout,*)' ' 
    280  
    281        ! Extra-halo initialization in MPP 
    282        IF( lk_mpp ) THEN 
    283           DO ji = nlci+1, jpi 
    284              tatm(ji,:) = tatm(1,:) 
    285              vatm(ji,:) = vatm(1,:) 
    286           ENDDO 
    287           DO jj = nlcj+1, jpj 
    288              tatm(:,jj) = tatm(:,1) 
    289              vatm(:,jj) = vatm(:,1) 
    290           ENDDO 
    291        ENDIF 
     131       
     132      !  3. Read monthly data from CLIO and From Xie 
     133      !  ------------------------------------------- 
     134       
     135      IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    292136          
    293     ENDIF 
    294  
    295  
    296     !  3. Read monthly data from CLIO and From Xie 
    297     !  ------------------------------------------- 
    298  
    299       IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    300  
    301137         ! calendar computation 
    302  
     138          
    303139         ! nflx1 number of the first file record used in the simulation 
    304140         ! flx2 number of the last  file record 
    305  
     141          
    306142         nflx1 = imois 
    307143         nflx2 = nflx1+1 
    … …  
    316152 
    317153         ! humidity 
    318          CALL flinget(numfl2,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx1, & 
    319             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,1)) 
    320          CALL flinget(numfl2,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx2, & 
    321             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,1)) 
     154         CALL iom_get ( numfl2, jpdom_data, 'socliohu', flxdta(:,:,1,1), nflx1 ) 
     155         CALL iom_get ( numfl2, jpdom_data, 'socliohu', flxdta(:,:,2,1), nflx2 ) 
    322156 
    323157         ! clouds 
    324          CALL flinget(numfl2,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx1, & 
    325             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,2)) 
    326          CALL flinget(numfl2,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx2, & 
    327             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,2)) 
     158         CALL iom_get ( numfl2, jpdom_data, 'socliocl', flxdta(:,:,1,2), nflx1 ) 
     159         CALL iom_get ( numfl2, jpdom_data, 'socliocl', flxdta(:,:,2,2), nflx2 ) 
    328160 
    329161         ! Read monthly precipitations ds flxdta(:,:,1 ou 2,4)  
    330162 
    331          CALL flinget(numfl3,'rain',jpidta,jpjdta,jpk,jpmois,nflx1, & 
    332             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,3)) 
    333          CALL flinget(numfl3,'rain',jpidta,jpjdta,jpk,jpmois,nflx2, & 
    334             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,3)) 
    335  
    336          ! Extra-halo initialization in MPP 
    337          IF( lk_mpp ) THEN 
    338             DO ji = nlci+1, jpi 
    339                flxdta(ji,:,1,1) = flxdta(1,:,1,1)   ;   flxdta(ji,:,2,1) = flxdta(1,:,2,1) 
    340                flxdta(ji,:,1,2) = flxdta(1,:,1,2)   ;   flxdta(ji,:,2,2) = flxdta(1,:,2,2) 
    341                flxdta(ji,:,1,3) = flxdta(1,:,1,3)   ;   flxdta(ji,:,2,3) = flxdta(1,:,2,3) 
    342             ENDDO 
    343             DO jj = nlcj+1, jpj 
    344                flxdta(:,jj,1,1) = flxdta(:,1,1,1)   ;   flxdta(:,jj,2,1) = flxdta(:,1,2,1) 
    345                flxdta(:,jj,1,2) = flxdta(:,1,1,2)   ;   flxdta(:,jj,2,2) = flxdta(:,1,2,2) 
    346                flxdta(:,jj,1,3) = flxdta(:,1,1,3)   ;   flxdta(:,jj,2,3) = flxdta(:,1,2,3) 
    347             ENDDO 
    348          ENDIF 
     163         CALL iom_get ( numfl3, jpdom_data, 'rain', flxdta(:,:,1,3), nflx1 ) 
     164         CALL iom_get ( numfl3, jpdom_data, 'rain', flxdta(:,:,2,3), nflx2 ) 
    349165                   
    350166      ENDIF 
    … …  
    364180 
    365181      IF( kt == nitend ) THEN 
    366          CALL flinclo(numfl1) 
    367          CALL flinclo(numfl2) 
    368          CALL flinclo(numfl3) 
     182         CALL iom_close (numfl1) 
     183         CALL iom_close (numfl2) 
     184         CALL iom_close (numfl3) 
     185         CALL iom_close (numfl4) 
    369186      ENDIF 
    370187 

  • trunk/NEMO/OPA_SRC/SBC/flx_bulk_monthly.h90

    r392 r473  
    1212      ji, jj,          &  ! loop indices 
    1313      numflx,          &  ! logical unit for surface fluxes data 
    14       nflx1, nflx2,    &  !  first and second record used 
     14      nflx1 , nflx2,   &  !  first and second record used 
    1515      nflx11, nflx12      ! ??? 
    1616 
    17    REAL(wp), DIMENSION(jpi,jpj,2,7) ::   & 
     17   INTEGER, PARAMETER :: jpf    =  7                    
     18   REAL(wp), DIMENSION(jpi,jpj,2,jpf) ::   & 
    1819      flxdta              ! 2 consecutive set of CLIO monthly fluxes 
    1920   !!---------------------------------------------------------------------- 
    … …  
    6061      !!        !  92-07  (M. Imbard) 
    6162      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files 
    62       !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl 
     63      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with io-ipsl 
    6364      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any 
    6465      !!                         daily wind stress data including a climatology 
    … …  
    6768      !!---------------------------------------------------------------------- 
    6869      !! * modules used 
    69       USE ioipsl 
     70      USE iom 
    7071      USE blk_oce         ! bulk variable 
    7172      USE bulk            ! bulk module 
    … …  
    7576 
    7677      !! * Local declarations 
    77       INTEGER, PARAMETER ::   & 
    78          jpmois = 12,               &  ! number of months 
    79          jpf    =  7                   ! ??? !bug ? 
    8078      INTEGER ::   jm, jt      ! dummy loop indices 
    8179      INTEGER ::   & 
    82          imois, imois2, itime,      &  ! temporary integers 
    83          i15  , iman  ,             &  !    "          " 
    84          ipi  , ipj   , ipk            !    "          " 
    85       INTEGER, DIMENSION(jpmois) ::   & 
    86          istep                         ! ??? 
     80         imois, imois2,       &  ! temporary integers 
     81         i15  , iman             !    "          " 
    8782      REAL(wp) ::   & 
    88          zsecond, zdate0,           &  ! temporary scalars 
    89          zxy    , zdtt  ,           &  !    "         " 
    90          zdatet , zttbt ,           &  !    "         " 
    91          zttat  , zdtts6               !    "         " 
    92       REAL(wp), DIMENSION(jpk) ::   & 
    93          zlev                          ! ??? 
    94       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    95          zlon   , zlat                 ! ??? 
    96       CHARACTER (len=32) ::   & 
    97          clname            ! flux filename 
     83         zxy    , zdtt  ,     &  !    "         " 
     84         zdatet , zttbt ,     &  !    "         " 
     85         zttat  , zdtts6         !    "         " 
    9886      !!--------------------------------------------------------------------- 
    99          clname = 'flx.nc' 
    100  
    10187 
    10288      ! Initialization 
    … …  
    10490 
    10591      i15 = INT( 2 * FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    106       iman  = 12 
     92      iman  = INT( raamo ) 
    10793      imois = nmonth + i15 - 1 
    10894      IF( imois == 0 ) imois = iman 
    10995      imois2 = nmonth 
    11096 
    111       itime = jpmois  
    112        
    113       ipi = jpiglo 
    114       ipj = jpjglo 
    115       ipk = jpk 
    116  
    117  
    11897      ! 1. first call kt=nit000 
    11998      ! ----------------------- 
    12099 
    121100      IF( kt == nit000 ) THEN 
     101         ! initializations 
    122102         nflx1  = 0 
    123103         nflx11 = 0 
     104         ! open the file 
    124105         IF(lwp) THEN 
    125             WRITE(numout,*) 
    126             WRITE(numout,*) ' global CLIO flx monthly fields in NetCDF format' 
    127             WRITE(numout,*) ' ------------------------------' 
    128             WRITE(numout,*) 
     106            WRITE(numout,*) ' ' 
     107            WRITE(numout,*) ' **** Routine flx_bulk_monthly.h90' 
     108            WRITE(numout,*) ' ' 
     109            WRITE(numout,*) ' global CLIO flx monthly fields' 
    129110         ENDIF 
    130           
    131          ! Read first records 
    132  
    133          ! title, dimensions and tests 
    134 #if defined key_agrif 
    135       if ( .NOT. Agrif_Root() ) then 
    136          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    137       endif 
    138 #endif     
    139          CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,   & 
    140             &          .FALSE., ipi, ipj, ipk, zlon, zlat, zlev,   & 
    141             &          itime, istep, zdate0, zsecond, numflx ) 
    142           
    143          ! temperature 
    144          ! Utilisation d'un spline, on lit le champ a mois=1 
    145          CALL flinget( numflx, 'socliot1', jpidta, jpjdta, jpk,   & 
    146             &          jpmois, 1, 1, mig(1), nlci,   & 
    147             &          mjg(1), nlcj, flxdta(1:nlci,1:nlcj,1,5) ) 
    148  
    149          ! Extra-halo initialization in MPP 
    150          IF( lk_mpp ) THEN 
    151             DO ji = nlci+1, jpi 
    152                flxdta(ji,:,1,5) = flxdta(1,:,1,5)   ;   flxdta(ji,:,2,5) = flxdta(1,:,2,5) 
    153             ENDDO 
    154             DO jj = nlcj+1, jpj 
    155                flxdta(:,jj,1,5) = flxdta(:,1,1,5)   ;   flxdta(:,jj,2,5) = flxdta(:,1,2,5) 
    156             ENDDO 
    157          ENDIF 
     111         CALL iom_open ( 'flx.nc', numflx ) 
     112         
     113         ! temperature, spline initialization, we read the first record 
     114         CALL iom_get ( numflx, jpdom_data, 'socliot1', flxdta(:,:,1,5), 1 ) 
     115 
    158116      ENDIF 
    159117 
    … …  
    181139 
    182140         ! humidity 
    183          CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx1,   & 
    184             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,1)) 
    185          CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx2,   & 
    186             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,1)) 
     141         CALL iom_get ( numflx, jpdom_data, 'socliohu', flxdta(:,:,1,1), nflx1 ) 
     142         CALL iom_get ( numflx, jpdom_data, 'socliohu', flxdta(:,:,2,1), nflx2 ) 
    187143         ! 10m wind module 
    188          CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx1,   & 
    189             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,2)) 
    190          CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx2,   & 
    191             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,2)) 
     144         CALL iom_get ( numflx, jpdom_data, 'socliowi', flxdta(:,:,1,2), nflx1 ) 
     145         CALL iom_get ( numflx, jpdom_data, 'socliowi', flxdta(:,:,2,2), nflx2 ) 
    192146         ! cloud cover 
    193          CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx1,   & 
    194             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,3)) 
    195          CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx2,   & 
    196             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,3)) 
     147         CALL iom_get ( numflx, jpdom_data, 'socliocl', flxdta(:,:,1,3), nflx1 ) 
     148         CALL iom_get ( numflx, jpdom_data, 'socliocl', flxdta(:,:,2,3), nflx2 ) 
    197149         ! precipitations 
    198          CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx1,   & 
    199             nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,4)) 
    200          CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx2,   & 
    201             nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,4)) 
     150         CALL iom_get ( numflx, jpdom_data, 'socliopl', flxdta(:,:,1,4), nflx1 ) 
     151         CALL iom_get ( numflx, jpdom_data, 'socliopl', flxdta(:,:,2,4), nflx2 ) 
    202152          
    203153         IF(lwp .AND. nitend-nit000 <= 100 ) THEN 
    … …  
    208158               WRITE(numout,*) 
    209159               WRITE(numout,*) 'Clio mounth: ',nflx1,'  field: ',jm,' multiply by ',0.1 
    210                CALL prihre(flxdta(:,:,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     160               CALL prihre( flxdta(:,:,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout ) 
    211161            END DO 
    212162         ENDIF 
    213163 
    214          ! Extra-halo initialization in MPP 
    215          IF( lk_mpp ) THEN 
    216             DO ji = nlci+1, jpi 
    217                flxdta(ji,:,1,1) = flxdta(1,:,1,1)   ;   flxdta(ji,:,2,1) = flxdta(1,:,2,1) 
    218                flxdta(ji,:,1,2) = flxdta(1,:,1,2)   ;   flxdta(ji,:,2,2) = flxdta(1,:,2,2) 
    219                flxdta(ji,:,1,3) = flxdta(1,:,1,3)   ;   flxdta(ji,:,2,3) = flxdta(1,:,2,3) 
    220                flxdta(ji,:,1,4) = flxdta(1,:,1,4)   ;   flxdta(ji,:,2,4) = flxdta(1,:,2,4) 
    221             ENDDO 
    222             DO jj = nlcj+1, jpj 
    223                flxdta(:,jj,1,1) = flxdta(:,1,1,1)   ;   flxdta(:,jj,2,1) = flxdta(:,1,2,1) 
    224                flxdta(:,jj,1,2) = flxdta(:,1,1,2)   ;   flxdta(:,jj,2,2) = flxdta(:,1,2,2) 
    225                flxdta(:,jj,1,3) = flxdta(:,1,1,3)   ;   flxdta(:,jj,2,3) = flxdta(:,1,2,3) 
    226                flxdta(:,jj,1,4) = flxdta(:,1,1,4)   ;   flxdta(:,jj,2,4) = flxdta(:,1,2,4) 
    227             ENDDO 
    228          ENDIF 
    229  
    230164      ENDIF 
    231  
    232       ! ------------------- ! 
    233       ! Last call kt=nitend ! 
    234       ! ------------------- ! 
    235  
    236       ! Closing of the numflx file (required in mpp) 
    237       IF( kt == nitend ) CALL flinclo(numflx) 
    238  
    239165 
    240166      IF( kt == nit000 .OR. imois2 /= nflx11 ) THEN 
    … …  
    258184         ! air temperature 
    259185         ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2 
    260          CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx11,   & 
    261             nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,6)) 
    262          CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx12,   & 
    263             nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,6)) 
     186         CALL iom_get (numflx,jpdom_data,'socliot1',flxdta(:,:,1,6),nflx11) 
     187         CALL iom_get (numflx,jpdom_data,'socliot1',flxdta(:,:,2,6),nflx12) 
    264188         ! air temperature derivative (to reconstruct a daily field) 
    265          CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx11,   & 
    266             nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,7)) 
    267          CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx12,   & 
    268             nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,7)) 
    269           
     189         CALL iom_get (numflx,jpdom_data,'socliot2',flxdta(:,:,1,7),nflx11) 
     190         CALL iom_get (numflx,jpdom_data,'socliot2',flxdta(:,:,2,7),nflx12) 
     191           
    270192         IF(lwp) THEN 
    271193            WRITE(numout,*) 
    … …  
    280202         ENDIF 
    281203 
    282          ! Extra-halo initialization in MPP 
    283          IF( lk_mpp ) THEN 
    284             DO ji = nlci+1, jpi 
    285                flxdta(ji,:,1,6) = flxdta(1,:,1,6)   ;   flxdta(ji,:,2,6) = flxdta(1,:,2,6) 
    286                flxdta(ji,:,1,7) = flxdta(1,:,1,7)   ;   flxdta(ji,:,2,7) = flxdta(1,:,2,7) 
    287             ENDDO 
    288             DO jj = nlcj+1, jpj 
    289                flxdta(:,jj,1,6) = flxdta(:,1,1,6)   ;   flxdta(:,jj,2,6) = flxdta(:,1,2,6) 
    290                flxdta(:,jj,1,7) = flxdta(:,1,1,7)   ;   flxdta(:,jj,2,7) = flxdta(:,1,2,7) 
    291             ENDDO 
    292          ENDIF 
    293           
    294204      ENDIF 
    295205 
    … …  
    321231      CALL blk( kt )                ! bulk formulea fluxes  
    322232 
     233      ! ------------------- ! 
     234      ! Last call kt=nitend ! 
     235      ! ------------------- ! 
     236 
     237      ! Closing of the numflx file (required in mpp) 
     238      IF( kt == nitend ) CALL iom_close (numflx) 
     239 
    323240   END SUBROUTINE flx 

  • trunk/NEMO/OPA_SRC/SBC/flx_forced_daily.h90

    r392 r473  
    1313   INTEGER ::          & 
    1414      numflx,          &  ! logical unit for surface fluxes data 
    15       nflx1, nflx2,    &  !  first and second record used 
    16       nflx11, nflx12,  &  ! ??? 
    17       ndayflx,         &  ! new day for ecmwf flx forcing 
    18       nyearflx            ! new year for ecmwf flx forcing 
     15      ndayflx             ! new day for ecmwf flx forcing 
    1916   REAL(wp), DIMENSION(jpi,jpj,3) ::   & 
    2017      flxdta              ! 3 consecutive daily fluxes 
    … …  
    4441      !!        !  92-07  (M. Imbard) 
    4542      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files 
    46       !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl 
     43      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with io-ipsl 
    4744      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any 
    4845      !!                         daily wind stress data including a climatology 
    … …  
    5148      !!---------------------------------------------------------------------- 
    5249      !! * Modules used 
    53       USE ioipsl 
     50      USE iom 
    5451      USE flx_oce 
    5552 
    … …  
    5754      INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    5855 
    59       !! * local declarations 
    60       INTEGER ::   ji, jj, jk        ! dummy loop arguments 
    61       INTEGER ::   iprint 
    62       INTEGER ::   i15, iy, iday, idy, ipi, ipj, ipk 
    63       INTEGER ,DIMENSION(366) :: istep 
    64  
    65       REAL(wp), DIMENSION(jpi,jpj) :: zlon, zlat 
    66       REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim 
    67       REAL(wp), DIMENSION(jpk)     :: zlev 
    68       REAL(wp) ::   zdate0, zdt 
    69  
    70       CHARACTER (len=40) :: clname 
    7156      !!--------------------------------------------------------------------- 
    72  
    73       ! Initialization 
    74       ! ----------------- 
    75        
    76       ! year month day 
    77       i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) ) 
    78       ipi = jpiglo 
    79       ipj = jpjglo 
    80       ipk = jpk 
    81       IF( nleapy == 0 ) THEN 
    82          idy = 365 
    83       ELSE IF( nleapy == 1 ) THEN 
    84          IF( MOD( nyear ,4 ) == 0 ) THEN 
    85             idy = 366 
    86          ELSE 
    87             idy = 365 
    88          ENDIF 
    89       ELSE IF( nleapy == 30 ) THEN 
    90          IF(lwp) WRITE(numout,cform_err) 
    91          IF(lwp) WRITE(numout,*)'flx.forced.h : nleapy = 30 is non compatible' 
    92          IF(lwp) WRITE(numout,*)'               with existing files' 
    93          nstop = nstop + 1 
    94       ENDIF 
    9557 
    9658 
    … …  
    9961 
    10062      IF( kt == nit000 ) THEN 
    101          IF(lwp) WRITE(numout,*) 
    102          IF(lwp) WRITE(numout,*) 'flx   : daily fluxes Q, Qsr, EmP' 
    103          IF(lwp) WRITE(numout,*) '~~ ' 
    104          ndayflx  = 0 
    105          nyearflx = 0 
    106       ENDIF 
     63          
     64         ndayflx = 0   ! Initialization 
     65         ! open the file 
     66         IF(lwp) THEN 
     67            WRITE(numout,*) ' ' 
     68            WRITE(numout,*) ' **** Routine flx_forced_daily.h90' 
     69            WRITE(numout,*) ' ' 
     70            WRITE(numout,*) ' daily fluxes Q, Qsr, EmP' 
     71         ENDIF 
     72         CALL iom_open ( 'flx_1d.nc', numflx ) 
    10773 
    108  
    109       ! Open files if nyearflx 
    110       ! ---------------------- 
    111  
    112       IF( nyearflx /= nyear ) THEN 
    113          nyearflx = nyear 
    114          iprint   = 1 
    115  
    116          ! Define file name and record 
    117           
    118          ! Close/open file if new year  
    119  
    120          IF( nyearflx /= 0 .AND. kt /= nit000 )   CALL flinclo(numflx) 
    121  
    122          iy = nyear 
    123          IF(lwp) WRITE (numout,*) iy 
    124          WRITE(clname,'("flx_1d.nc")')  
    125 #if defined key_agrif 
    126       if ( .NOT. Agrif_Root() ) then 
    127          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    128       endif 
    129 #endif          
    130          IF(lwp) WRITE (numout,*)' open flx file = ',clname 
    131          CALL FLUSH(numout) 
    132           
    133          CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj   & 
    134               ,ipk,zlon,zlat,zlev,idy,istep,zdate0,zdt,numflx) 
    135  
    136          IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN 
    137             IF(lwp) WRITE(numout,cform_err) 
    138             IF(lwp) WRITE(numout,*) 
    139             IF(lwp) WRITE(numout,*) 'problem with dimensions' 
    140             IF(lwp) WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    141             IF(lwp) WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    142             IF(lwp) WRITE(numout,*) ' ipk ',ipk,' =? 1' 
    143             nstop = nstop + 1 
    144          ENDIF 
    145          IF(lwp) WRITE(numout,*) idy,istep,zdate0,zdt,numflx 
    146       ELSE 
    147          iprint = 0 
    14874      ENDIF 
    14975 
    … …  
    15480       
    15581      IF( ndayflx /= nday ) THEN  
     82          
    15683         ndayflx = nday 
    157           
    158          iday = nday_year 
    159           
     84                   
    16085         ! read Qtot 
    161          CALL flinget(numflx,'sohefldo',jpidta,jpjdta,1,idy,iday,   & 
    162               iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1)) 
     86         CALL iom_get ( numflx, jpdom_data, 'sohefldo', flxdta(:,:,1), nday_year ) 
    16387         ! read qsr 
    164          CALL flinget(numflx,'soshfldo',jpidta,jpjdta,1,idy,iday,   & 
    165               iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2)) 
     88         CALL iom_get ( numflx, jpdom_data, 'soshfldo', flxdta(:,:,2), nday_year ) 
    16689         ! read emp 
    167          CALL flinget(numflx,'sowaflup',jpidta,jpjdta,1,idy,iday,   & 
    168               iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,3)) 
     90         CALL iom_get ( numflx, jpdom_data, 'sowaflup', flxdta(:,:,3), nday_year ) 
    16991 
    17092         IF(lwp) WRITE (numout,*)'Lecture flx record :',iday 
    … …  
    17799                  WRITE(numout,*) 
    178100                  WRITE(numout,*) ' Q * .1, day: ',ndastp 
    179                   CALL prihre(flxdta(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     101                  CALL prihre( flxdta(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout ) 
    180102                  WRITE(numout,*) 
    181103                  WRITE(numout,*) ' QSR * .1, day: ',ndastp 
    182                   CALL prihre(flxdta(:,:,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     104                  CALL prihre( flxdta(:,:,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout ) 
    183105                  WRITE(numout,*) 
    184106                  WRITE(numout,*) ' E-P *86400, day: ',ndastp 
    185                   CALL prihre(flxdta(:,:,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout) 
     107                  CALL prihre( flxdta(:,:,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout ) 
    186108                  WRITE(numout,*) ' ' 
    187109               ENDIF 
    … …  
    193115      p_qsr(:,:) = flxdta(:,:,2) 
    194116      p_emp(:,:) = flxdta(:,:,3) 
    195   
    196       ! Boundary condition on emp for free surface option 
    197       ! ------------------------------------------------- 
    198       CALL lbc_lnk( p_emp, 'T', 1. ) 
    199   
    200   
     117   
    201118      ! Closing all files 
    202119      ! ----------------- 
    203120  
    204       IF( kt == nitend ) CALL flinclo( numflx ) 
     121      IF( kt == nitend ) CALL iom_close ( numflx ) 
    205122  
    206123   END SUBROUTINE flx 

  • trunk/NEMO/OPA_SRC/SBC/flxmod.F90

    r440 r473  
    5050   !!---------------------------------------------------------------------- 
    5151#  include "flx_bulk_daily.h90" 
     52 
     53#elif defined key_flx_core 
     54   !!---------------------------------------------------------------------- 
     55   !!   'key_flx_core'   and                     NCAR data (Large & Yeager) 
     56   !!                                                          Net CDF file 
     57   !!---------------------------------------------------------------------- 
     58#  include "flx_core.h90" 
    5259 
    5360#elif defined key_flx_forced_daily 

  • trunk/NEMO/OPA_SRC/SBC/flxrnf.F90

    r389 r473  
    2222   USE in_out_manager  ! I/O manager 
    2323   USE daymod          ! calendar 
    24    USE ioipsl          ! NetCDF IPSL library 
     24   USE iom             ! I/O module 
    2525 
    2626   IMPLICIT NONE 
    … …  
    3838      upsrnfz              !: mixed adv scheme in runoffs vicinity (vert.) 
    3939   INTEGER, PUBLIC ::   &  !: 
    40       nrunoff =  0 ,    &  !: runoff option (namelist) 
    41       nrnf1, nrnf2         !: first and second record used 
     40      nrunoff =  0         !: runoff option (namelist) 
    4241 
    4342   !! * Module variable 
    4443   REAL(wp), DIMENSION(jpi,jpj,2) ::   &  !: 
    4544      rnfdta               !: monthly runoff data array (kg/m2/s) 
     45   INTEGER  ::          &  !: 
     46      numrnf,           &  !: logical unit for runoff data 
     47      nrnf1, nrnf2         !: first and second record used 
    4648   !!---------------------------------------------------------------------- 
    4749   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    103105      REAL(wp) ::   zxy 
    104106# endif 
    105       CHARACTER (len=32) ::   & 
    106          clname                            ! monthly runoff filename 
    107       INTEGER, PARAMETER :: jpmois = 12 
    108       INTEGER  ::   ipi, ipj, ipk          ! temporary integers 
    109107      INTEGER  ::   ii0, ii1, ij0, ij1     !    "          " 
    110       INTEGER, DIMENSION(jpmois) ::     & 
    111          istep                             ! temporary workspace 
    112       REAL(wp) ::   zdate0, zdt            ! temporary scalars 
    113       REAL(wp), DIMENSION(jpk) ::       & 
    114          zlev                              ! temporary workspace 
    115       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    116          zlon, zlat,                    &  ! temporary workspace 
    117          zcoefr                            ! coeff of advection link to runoff 
    118108      !!---------------------------------------------------------------------- 
    119          clname = 'runoff_1m_nomask'       ! monthly runoff filename 
    120109       
    121110      IF( kt == nit000 ) THEN 
    … …  
    139128 
    140129         CASE DEFAULT 
    141             IF(lwp) WRITE(numout,cform_err) 
    142             IF(lwp) WRITE(numout,*) ' Error nrunoff = ', nrunoff, ' /= 0, 1 or 2' 
    143             nstop = nstop + 1 
     130            WRITE(ctmp1,*) ' Error nrunoff = ', nrunoff, ' /= 0, 1 or 2' 
     131            CALL ctl_stop( ctmp1 ) 
    144132 
    145133         END SELECT 
    146134 
    147135         ! Set runoffs and upstream coeff to zero 
    148          runoff (:,:) = 0.e0 
    149          upsrnfh(:,:) = 0.e0 
    150          upsrnfz(:)   = 0.e0  
    151136         upsadv (:,:) = 0.e0 
    152137 
    … …  
    161146 
    162147         ! year, month, day 
     148         iman  = INT( raamo ) 
     149!!! better but change the results      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    163150         i15   = nday / 16 
    164151         imois = nmonth + i15 - 1 
    165          IF( imois == 0 )   imois = jpmois 
     152         IF( imois == 0 ) imois = iman 
    166153         ! Number of days in the month 
    167154         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    … …  
    175162         idmeom = idbd - 15 
    176163# endif 
    177          ipi = jpiglo 
    178          ipj = jpjglo 
    179          ipk = jpk 
    180          zdt = rdt 
    181164          
    182165         ! Open file 
    183166 
    184167         IF( kt == nit000 ) THEN 
    185             iman = jpmois 
    186             CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,    & 
    187                &           .false., ipi, ipj, ipk, zlon,        & 
    188                &           zlat, zlev, iman, istep, zdate0,   & 
    189                &           zdt, numrnf ) 
    190             !   Title, dimensions and tests 
    191 # if ! defined key_coupled 
    192             IF( iman /= jpmois ) THEN 
    193                IF(lwp) WRITE(numout,*) 
    194                IF(lwp) WRITE(numout,*) 'problem with time coordinates' 
    195                IF(lwp) WRITE(numout,*) ' iman ', iman, ' jpmois ', jpmois 
    196                nstop = nstop + 1 
    197             ENDIF 
    198             IF(lwp) WRITE(numout,*) iman, istep, zdate0, rdt, numrnf 
    199             IF(lwp) WRITE(numout,*) 'numrnf=', numrnf 
    200             IF(lwp) WRITE(numout,*) 'jpmois=', jpmois 
    201             IF(lwp) WRITE(numout,*) 'zdt=', zdt 
    202 # endif 
    203             IF(ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN 
    204                IF(lwp)WRITE(numout,*) ' ' 
    205                IF(lwp)WRITE(numout,*) 'problem with dimensions' 
    206                IF(lwp)WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta 
    207                IF(lwp)WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta 
    208                IF(lwp)WRITE(numout,*) ' ipk ', ipk, ' =? 1' 
    209                nstop = nstop + 1 
    210             ENDIF 
    211             IF(lwp)WRITE(numout,*) 'ipi=', ipi, ' ipj=', ipj, ' ipk=', ipk 
     168 
     169            nrnf1 = 0   ! initialization 
     170            IF (lwp) WRITE(numout,*) 'flx_rnf : Monthly runoff' 
     171            CALL iom_open ( 'runoff_1m_nomask.nc', numrnf ) 
     172             
    212173         ENDIF 
    213174          
    … …  
    223184            !     nrnf2 number of the last  array record 
    224185 
    225             iman = jpmois 
    226186            nrnf1 = imois 
    227187            nrnf2 = nrnf1 + 1 
    … …  
    237197               WRITE(numout,*) ' NetCDF format' 
    238198               WRITE(numout,*) 
    239                WRITE(numout,*) 'first array record used nrnf1 ',nrnf1 
    240                WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2 
     199               WRITE(numout,*) 'first array record used nrnf1 ', nrnf1 
     200               WRITE(numout,*) 'last  array record used nrnf2 ', nrnf2 
    241201               WRITE(numout,*) 
    242202            ENDIF 
    243203             
    244204            ! Read monthly runoff data in kg/m2/s 
    245 !ibug 
    246             IF( kt == nit000 )   rnfdta(:,:,:) = 0.e0 
    247 !ibug 
    248             CALL flinget( numrnf, 'sorunoff', jpidta, jpjdta, 1, jpmois   & 
    249                &        , nrnf1, nrnf1, mig(1), nlci, mjg(1), nlcj, rnfdta(1:nlci,1:nlcj,1) ) 
    250             CALL flinget( numrnf, 'sorunoff', jpidta, jpjdta, 1, jpmois   & 
    251                &        , nrnf2, nrnf2, mig(1), nlci, mjg(1), nlcj, rnfdta(1:nlci,1:nlcj,2) ) 
    252  
    253             IF(lwp) WRITE(numout,*) 
    254             IF(lwp) WRITE(numout,*) ' read runoff field ok' 
    255             IF(lwp) WRITE(numout,*) 
     205 
     206            CALL iom_get ( numrnf, jpdom_data, 'sorunoff', rnfdta(:,:,1), nrnf1 ) 
     207            CALL iom_get ( numrnf, jpdom_data, 'sorunoff', rnfdta(:,:,2), nrnf2 ) 
    256208 
    257209         ENDIF 
    … …  
    267219         ! when reading the NetCDF file runoff_1m_nomask.nc 
    268220         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN 
    269          DO jj = 1, jpj 
    270             DO ji = 1, jpi 
    271                IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   runoff(ji,jj) = 0.85 * runoff(ji,jj) 
     221            DO jj = 1, jpj 
     222               DO ji = 1, jpi 
     223                  IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   runoff(ji,jj) = 0.85 * runoff(ji,jj) 
     224               END DO 
    272225            END DO 
    273          END DO 
    274226         ENDIF 
    275227          
    … …  
    290242         !  coefr * upstream + (1- coefr) centered 
    291243         !  coefr must be between 0 and 1. 
    292 !ibug 
    293          zcoefr(:,:) = 0.e0 
    294 !ibug 
    295  
    296          CALL flinget( numrnf, 'socoefr', jpidta, jpjdta, 1, jpmois, nrnf1,   & 
    297             &          nrnf1, mig(1), nlci, mjg(1), nlcj, zcoefr(1:nlci,1:nlcj) ) 
    298  
    299          IF(lwp) WRITE(numout,*) 
    300          IF(lwp) WRITE(numout,*) ' read coefr for advection ok' 
    301          IF(lwp) WRITE(numout,*) 
    302           
    303          upsrnfh(:,:) = zcoefr(:,:) 
     244 
     245         CALL iom_get ( numrnf, jpdom_data, 'socoefr', upsrnfh ) 
     246          
    304247         upsrnfz(:)   = 0.e0 
    305248         upsrnfz(1)   = 1.0 
    … …  
    371314      ! -------------------- 
    372315 
    373       IF( kt == nitend .AND. nrunoff >= 1 )   CALL flinclo( numrnf ) 
     316      IF( kt == nitend .AND. nrunoff >= 1 )   CALL iom_close( numrnf ) 
    374317 
    375318   END SUBROUTINE flx_rnf 

  • trunk/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R05.h90

    r247 r473  
    2424      upsrnfz               !: mixed adv scheme in runoffs vicinity (vert.) 
    2525   INTEGER , PUBLIC ::   &  !: 
    26       numrof  = 48 ,     &  !: logical unit for runoff data 
    27       nrunoff =  0 ,     &  !: runoff option (namelist) 
    28       nrnf1, nrnf2          !: first and second record used 
     26      nrunoff =  0          !: runoff option (namelist) 
    2927 
    3028   !! * Module variable 
    3129   REAL(wp), DIMENSION(jpi,jpj,2) ::   &  !: 
    3230      rnfdta                !: monthly runoff data array (kg/m2/s) 
     31   INTEGER    ::         &  !: 
     32      nrnf1, nrnf2          !: first and second record used 
    3333   !!---------------------------------------------------------------------- 
    3434   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    8080      !!---------------------------------------------------------------------- 
    8181      !! * Modules used 
    82       USE ioipsl 
    8382 
    8483      !! * arguments 
    … …  
    9493      INTEGER, PARAMETER ::   & 
    9594         jpmois=12,   &  ! number of month in the year ! 
    96          jpriv=120,   &  ! maximum number of rivers 
     95         jpriv=200,   &  ! maximum number of rivers 
    9796         jpcoef=20       ! maximum number of gridpoints for mouth rivers 
    9897 
    … …  
    215214      ! --> 1111.99988m3/s 
    216215      DATA inb(12)/2/ 
    217       DATA (iirnf(jc,12),jc=1,jpcoef)/ 244, 245, 18*0 / 
     216      DATA (iirnf(jc,12),jc=1,jpcoef)/ 244, 244, 18*0 / 
    218217      DATA (ijrnf(jc,12),jc=1,jpcoef)/ 413, 414, 18*0 / 
    219218      DATA (zrnfm(jm,12),jm=1,jpmois)/   & 
    … …  
    372371      DATA (iirnf(jc,32),jc=1,jpcoef)/ 635, 635, 636, 636, 636,637, 637,637,12*0 / 
    373372      DATA (ijrnf(jc,32),jc=1,jpcoef)/ 508, 509, 509, 508, 507,509, 508,507,12*0 / 
    374       DATA (zrnfm(jm,32),jm=1,jpmois)/   & 
    375            4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   & 
    376           30773.,   22785.,   14701.,    9705.,    6078.,    5879./ 
     373     DATA (zrnfm(jm,32),jm=1,jpmois)/12*0./ 
     374!CT bug     DATA (zrnfm(jm,32),jm=1,jpmois)/   & 
     375!CT bug          4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   & 
     376!CT bug         30773.,   22785.,   14701.,    9705.,    6078.,    5879./ 
    377377      ! 33-Yenesei (Russia) 71N50 82E40                     R1  
    378378      ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s 
    … …  
    498498      DATA (ijrnf(jc,49),jc=1,jpcoef)/ 269, 270, 270, 17*0 / 
    499499      DATA (zrnfm(jm,49),jm=1,jpmois)/12*14893./ 
    500       ! 50-Irrawady (Burma) 15N50  95E06                    R5 
    501       ! Old=428 km3/year=13563m3/s; not in UNESCO data base 
    502       ! --> 13563.m3/s 
    503       DATA inb(50)/2/ 
    504       DATA (iirnf(jc,50),jc=1,jpcoef)/  44,  45, 18*0 / 
    505       DATA (ijrnf(jc,50),jc=1,jpcoef)/ 283, 282, 18*0 / 
    506       DATA (zrnfm(jm,50),jm=1,jpmois)/12*13563./ 
    507       ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00          R1 
    508       ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s 
    509       ! --> 32147.498m3/s 
    510       DATA inb(51)/4/ 
    511       DATA (iirnf(jc,51),jc=1,jpcoef)/  36,  37,  38,  39, 16*0 / 
    512       DATA (ijrnf(jc,51),jc=1,jpcoef)/ 295, 295, 295, 295, 16*0 / 
    513       DATA (zrnfm(jm,51),jm=1,jpmois)/   & 
    514            6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   & 
    515           64688.,   80338.,   84802.,   43387.,   17888.,   10322./ 
    516       ! 52-Mehandi (India)                                  R5 
    517       ! Old=67 km3/year=2123m3/s; not in UNESCO data base 
    518       ! --> 0m3/s 
     500 
     501      DATA inb(50)/0/ 
     502      DATA inb(51)/0/ 
    519503      DATA inb(52)/0/ 
    520       DATA (iirnf(jc,52),jc=1,jpcoef)/ 20*0 / 
    521       DATA (ijrnf(jc,52),jc=1,jpcoef)/ 20*0 / 
    522       DATA (zrnfm(jm,52),jm=1,jpmois)/12*2123./ 
     504 
    523505      ! 53-Damodar (India)                                  R2 
    524506      ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85 
    … …  
    530512           51.,      37.,      42.,      49.,      85.,     296.,   & 
    531513          896.,    1390.,    1591.,     542.,     172.,      44./    
    532       ! 54-Godavari (India) 17N00  81E45                    R2 
    533       ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39 
    534       ! --> 3670.5m3/s 
    535       DATA inb(54)/1/ 
    536       DATA (iirnf(jc,54),jc=1,jpcoef)/  19, 19*0 / 
    537       DATA (ijrnf(jc,54),jc=1,jpcoef)/ 283, 19*0 / 
    538       DATA (zrnfm(jm,54),jm=1,jpmois)/   & 
    539            988.,     737.,     280.,     219.,     196.,    1691.,   & 
    540           8063.,   14571.,   11428.,    3953.,    1221.,     699./    
    541       ! 55-Indus (Pakistan) 24N20  67E47             R2 
    542       ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15 
    543       ! --> 7562.m3/s 
    544       DATA inb(55)/4/ 
    545       DATA (iirnf(jc,55),jc=1,jpcoef)/ 711, 711, 712, 713, 16*0 / 
    546       DATA (ijrnf(jc,55),jc=1,jpcoef)/ 297, 298, 297, 297, 16*0 / 
    547       DATA (zrnfm(jm,55),jm=1,jpmois)/   & 
    548             988.,     737.,    1904.,    1968.,    3625.,    6143.,   & 
    549           15969.,    36656.,  17173.,    3215.,    1251.,    1115./    
    550       ! 56-Tigris and Euphrates (Iraq) 31N00  47E25         R1 
    551       ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s 
    552       ! --> 2248.8335m3/s 
    553       DATA inb(56)/3/ 
    554       DATA (iirnf(jc,56),jc=1,jpcoef)/ 673, 673, 674, 17*0 / 
    555       DATA (ijrnf(jc,56),jc=1,jpcoef)/ 312, 313, 313, 17*0 / 
    556       DATA (zrnfm(jm,56),jm=1,jpmois)/   & 
    557           1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   & 
    558           1362.,     900.,     786.,     993.,    1184.,    1742./    
    559  
     514 
     515      DATA inb(54)/0/ 
     516      DATA inb(55)/0/ 
     517      DATA inb(56)/0/ 
    560518      DATA inb(57)/0/ 
    561519      DATA inb(58)/0/ 
    … …  
    632590      DATA inb(68)/1/ 
    633591      DATA (iirnf(jc,68),jc=1,jpcoef)/ 599, 19*0 / 
    634       DATA (ijrnf(jc,68),jc=1,jpcoef)/ 241, 19*0 / 
     592      DATA (ijrnf(jc,68),jc=1,jpcoef)/ 240, 19*0 / 
    635593      DATA (zrnfm(jm,68),jm=1,jpmois)/   & 
    636594          1115.,    1166.,    1285.,    1462.,    1454.,     725.,   & 
    … …  
    686644      DATA inb(74)/1/ 
    687645      DATA (iirnf(jc,74),jc=1,jpcoef)/ 594, 19*0 / 
    688       DATA (ijrnf(jc,74),jc=1,jpcoef)/ 258, 19*0 / 
     646      DATA (ijrnf(jc,74),jc=1,jpcoef)/ 257, 19*0 / 
    689647      DATA (zrnfm(jm,74),jm=1,jpmois)/   & 
    690648           88.,      63.,      68.,      95.,     139.,     222.,   & 
    … …  
    729687      DATA inb(79)/0/ 
    730688      DATA inb(80)/0/ 
     689      DATA inb(81)/0/ 
    731690      DATA inb(82)/0/ 
    732691      DATA inb(83)/0/ 
    … …  
    809768      DATA inb(99)/1/ 
    810769      DATA (iirnf(jc,99),jc=1,jpcoef)/  98, 19*0 / 
    811       DATA (ijrnf(jc,99),jc=1,jpcoef)/ 287, 19*0 / 
     770      DATA (ijrnf(jc,99),jc=1,jpcoef)/ 288, 19*0 / 
    812771      DATA (zrnfm(jm,99),jm=1,jpmois)/12*127./ 
    813772      ! 100-Hsiukuluan (Taiwan)                             R5 
    … …  
    819778      DATA (zrnfm(jm,100),jm=1,jpmois)/12*127./ 
    820779 
    821       DATA inb(101)/0/ 
    822       DATA inb(102)/0/ 
     780 
     781 
     782 
     783 
     784 
     785 
     786       ! I ASIA 
     787       ! ------ 
     788 
     789       ! 1-Indus (Pakistan) 
     790       ! --> 3949m3/s 
     791       DATA inb(101)/4/ 
     792       DATA (iirnf(jc,101),jc=1,jpcoef)/ 711, 711, 712, 713, 16*0 / 
     793       DATA (ijrnf(jc,101),jc=1,jpcoef)/ 297, 298, 297, 297, 16*0 / 
     794       DATA (zrnfm(jm,101),jm=1,jpmois)/  & 
     795     &      1691.,    2121.,    2083.,    2940.,    3738.,    4198.,  & 
     796     &      5334.,    8247.,    7833.,    4908.,    2681.,    1614./ 
     797       ! 2-Sabarmati+Mahi+Narmada (India) 
     798       ! --> 3383m3/s 
     799       DATA inb(102)/1/ 
     800!CT bug point terre       DATA (iirnf(jc,102),jc=1,jpcoef)/ 720, 19*0 / 
     801!CT bug point terre       DATA (ijrnf(jc,102),jc=1,jpcoef)/ 292, 19*0 / 
     802       DATA (iirnf(jc,102),jc=1,jpcoef)/ 719, 19*0 / 
     803       DATA (ijrnf(jc,102),jc=1,jpcoef)/ 291, 19*0 / 
     804       DATA (zrnfm(jm,102),jm=1,jpmois)/  & 
     805     &      1343.,     110.,       0.,       0.,      13.,    3051.,  & 
     806     &      9453.,   11655.,    7619.,    3547.,    2081.,    1727./ 
     807       ! 3- 
     808       ! --> 182m3/s 
     809       DATA inb(103)/1/ 
     810!CT bug point terre       DATA (iirnf(jc,103),jc=1,jpcoef)/ 721, 19*0 / 
     811!CT bug point terre       DATA (ijrnf(jc,103),jc=1,jpcoef)/ 286, 19*0 / 
     812       DATA (iirnf(jc,103),jc=1,jpcoef)/ 720, 19*0 / 
     813       DATA (ijrnf(jc,103),jc=1,jpcoef)/ 286, 19*0 / 
     814       DATA (zrnfm(jm,103),jm=1,jpmois)/  & 
     815     &      0.,       0.,       0.,       0.,     225.,     669.,  & 
     816     &      526.,     327.,     187.,     100.,      62.,      92./ 
     817       ! 4-Mandovi + Zuari + Kalinadi 
     818       ! --> 347m3/s 
     819       DATA inb(104)/1/ 
     820       DATA (iirnf(jc,104),jc=1,jpcoef)/ 2, 19*0 / 
     821       DATA (ijrnf(jc,104),jc=1,jpcoef)/ 282, 19*0 / 
     822       DATA (zrnfm(jm,104),jm=1,jpmois)/  & 
     823     &      7.,       0.,       0.,       0.,     428.,    1339.,  & 
     824     &      966.,     601.,     350.,     190.,     117.,     166./ 
     825       ! 5-                    R2 
     826       ! --> 190m3/s 
     827       DATA inb(105)/1/ 
     828       DATA (iirnf(jc,105),jc=1,jpcoef)/ 4, 19*0 / 
     829       DATA (ijrnf(jc,105),jc=1,jpcoef)/ 279, 19*0 / 
     830       DATA (zrnfm(jm,105),jm=1,jpmois)/  & 
     831     &      0.,       0.,       0.,       0.,     363.,     710.,   & 
     832     &      484.,     315.,     172.,      95.,      59.,      87./ 
     833       ! 6- 
     834       ! --> 1101m3/s 
     835       DATA inb(106)/1/ 
     836       DATA (iirnf(jc,106),jc=1,jpcoef)/ 4, 19*0 / 
     837       DATA (ijrnf(jc,106),jc=1,jpcoef)/ 277, 19*0 / 
     838       DATA (zrnfm(jm,106),jm=1,jpmois)/   & 
     839     &      79.,       0.,       0.,       0.,    1457.,    3639.,   & 
     840     &      3084.,    2031.,    1282.,     696.,     414.,     535. / 
     841       ! 7- 
     842       ! --> 948m3/s 
     843       DATA inb(107)/1/ 
     844       DATA (iirnf(jc,107),jc=1,jpcoef)/ 5, 19*0 / 
     845       DATA (ijrnf(jc,107),jc=1,jpcoef)/ 275, 19*0 / 
     846       DATA (zrnfm(jm,107),jm=1,jpmois)/  & 
     847     &      72.,       0.,       0.,       0.,    1151.,    3038.,     &  
     848     &      2583.,    1603.,    1216.,     749.,     426.,     539./ 
     849 
     850       ! 8- 
     851       ! --> 551m3/s 
     852       DATA inb(108)/1/ 
     853       DATA (iirnf(jc,108),jc=1,jpcoef)/ 7, 19*0 / 
     854       DATA (ijrnf(jc,108),jc=1,jpcoef)/ 271, 19*0 / 
     855       DATA (zrnfm(jm,108),jm=1,jpmois)/  & 
     856     &      45.,       0.,       2.,       7.,     680.,    1621.,  & 
     857     &      1234.,     744.,     784.,     696.,     359.,     442. / 
     858       ! 9- 
     859       ! --> 103m3/s 
     860       DATA inb(109)/1/ 
     861       DATA (iirnf(jc,109),jc=1,jpcoef)/ 8, 19*0 / 
     862       DATA (ijrnf(jc,109),jc=1,jpcoef)/ 269, 19*0 / 
     863       DATA (zrnfm(jm,109),jm=1,jpmois)/  & 
     864     &      11.,       0.,       0.,       0.,     160.,     250.,   & 
     865     &      200.,     145.,     168.,     146.,      74.,      89. / 
     866       ! 10- 
     867       ! --> 99m3/s 
     868       DATA inb(110)/1/ 
     869       DATA (iirnf(jc,110),jc=1,jpcoef)/12, 19*0 / 
     870       DATA (ijrnf(jc,110),jc=1,jpcoef)/267, 19*0 / 
     871       DATA (zrnfm(jm,110),jm=1,jpmois)/  & 
     872     &      50.,       1.,       1.,       0.,      25.,      69.,  & 
     873     &      51.,      32.,     176.,     329.,     233.,     222./ 
     874       ! 11- Kaveri (India) 
     875       ! --> 173m3/s 
     876       DATA inb(111)/1/ 
     877       DATA (iirnf(jc,111),jc=1,jpcoef)/16, 19*0 / 
     878       DATA (ijrnf(jc,111),jc=1,jpcoef)/271, 19*0 / 
     879       DATA (zrnfm(jm,111),jm=1,jpmois)/  & 
     880     &       97.,       2.,       1.,       2.,      19.,      67.,   & 
     881     &      108.,     134.,     218.,     515.,     498.,     416. / 
     882       ! 12- 
     883       ! --> 116m3/s 
     884       DATA inb(112)/1/ 
     885       DATA (iirnf(jc,112),jc=1,jpcoef)/16, 19*0 / 
     886       DATA (ijrnf(jc,112),jc=1,jpcoef)/279, 19*0 / 
     887       DATA (zrnfm(jm,112),jm=1,jpmois)/  & 
     888     &       43.,       0.,       0.,       0.,       0.,       0.,   & 
     889     &        0.,       0.,      99.,     568.,     343.,     342. / 
     890       ! 13- Krishna 
     891       ! --> 2864m3/s 
     892       DATA inb(113)/1/ 
     893       DATA (iirnf(jc,113),jc=1,jpcoef)/ 16, 19*0 / 
     894       DATA (ijrnf(jc,113),jc=1,jpcoef)/ 281, 19*0 / 
     895       DATA (zrnfm(jm,113),jm=1,jpmois)/   & 
     896     &       1368.,     174.,       0.,       0.,     166.,    2362.,  & 
     897     &       9501.,    8639.,    6053.,    3173.,    1763.,    1175. / 
     898       ! 14- (SriLanka) 
     899       ! --> 371m3/s 
     900       DATA inb(114)/1/ 
     901       DATA (iirnf(jc,114),jc=1,jpcoef)/ 16, 19*0 / 
     902       DATA (ijrnf(jc,114),jc=1,jpcoef)/ 261, 19*0 / 
     903       DATA (zrnfm(jm,114),jm=1,jpmois)/  & 
     904     &      171.,     144.,     292.,     469.,     414.,     309.,  & 
     905     &      269.,     244.,     526.,     560.,     476.,     588.  / 
     906       ! 15- (SriLanka) 
     907       ! --> 305m3/s 
     908       DATA inb(115)/1/ 
     909       DATA (iirnf(jc,115),jc=1,jpcoef)/18, 19*0 / 
     910       DATA (ijrnf(jc,115),jc=1,jpcoef)/262, 19*0 / 
     911       DATA (zrnfm(jm,115),jm=1,jpmois)/  & 
     912     &      116.,     111.,     225.,     379.,     366.,     300.,  & 
     913     &      256.,     239.,     385.,     437.,     388.,     467. / 
     914       ! 16- (SriLanka) 
     915       ! --> 722m3/s 
     916       DATA inb(116)/1/ 
     917       DATA (iirnf(jc,116),jc=1,jpcoef)/20, 19*0 / 
     918       DATA (ijrnf(jc,116),jc=1,jpcoef)/265, 19*0 / 
     919       DATA (zrnfm(jm,116),jm=1,jpmois)/  & 
     920     &      711.,     347.,     477.,     556.,     430.,     302.,  & 
     921     &      228.,     200.,     629.,    1156.,    1579.,    2055.   / 
     922       ! 17- (SriLanka) 
     923       ! --> 188m3/s 
     924       DATA inb(117)/1/ 
     925       DATA (iirnf(jc,117),jc=1,jpcoef)/19, 19*0 / 
     926       DATA (ijrnf(jc,117),jc=1,jpcoef)/267, 19*0 / 
     927       DATA (zrnfm(jm,117),jm=1,jpmois)/  & 
     928     &      189.,      50.,      27.,      17.,      10.,       6.,  & 
     929     &       4.,       2.,       1.,     236.,     829.,     894. / 
     930       ! 18- Godavari (India) 17N00  81E45 
     931       ! --> 2709m3/s 
     932       DATA inb(118)/1/ 
     933       DATA (iirnf(jc,118),jc=1,jpcoef)/ 19, 19*0 / 
     934       DATA (ijrnf(jc,118),jc=1,jpcoef)/283, 19*0 / 
     935       DATA (zrnfm(jm,118),jm=1,jpmois)/  & 
     936     &      1151.,      57.,       0.,       0.,      38.,    1490.,  & 
     937     &      6714.,    9065.,    7208.,    3294.,    1874.,    1629. / 
     938       ! 19- 
     939       ! --> 116m3/s 
     940       DATA inb(119)/1/ 
     941       DATA (iirnf(jc,119),jc=1,jpcoef)/23, 19*0 / 
     942       DATA (ijrnf(jc,119),jc=1,jpcoef)/286, 19*0 / 
     943       DATA (zrnfm(jm,119),jm=1,jpmois)/  & 
     944     &         17.,       0.,       0.,       0.,       0.,     103.,  & 
     945     &        259.,     341.,     330.,     155.,      87.,     110. / 
     946       ! 20- Mahanadi (India) 
     947       ! --> 2390m3/s 
     948       DATA inb(120)/1/ 
     949       DATA (iirnf(jc,120),jc=1,jpcoef)/28, 19*0 / 
     950       DATA (ijrnf(jc,120),jc=1,jpcoef)/290, 19*0 / 
     951       DATA (zrnfm(jm,120),jm=1,jpmois)/  & 
     952     &       809.,       5.,       0.,       0.,      60.,    1401.,  & 
     953     &      6652.,    8828.,    5410.,    2561.,    1503.,    1452. / 
     954       ! 21- 
     955       ! --> 247m3/s 
     956       DATA inb(121)/1/ 
     957       DATA (iirnf(jc,121),jc=1,jpcoef)/30, 19*0 / 
     958       DATA (ijrnf(jc,121),jc=1,jpcoef)/294, 19*0 / 
     959       DATA (zrnfm(jm,121),jm=1,jpmois)/  & 
     960     &         15.,       0.,       0.,       0.,      73.,     367.,   & 
     961     &        744.,     722.,     491.,     227.,     137.,     188. / 
     962       ! 22- 
     963       ! --> 167m3/s 
     964       DATA inb(122)/1/ 
     965       DATA (iirnf(jc,122),jc=1,jpcoef)/31, 19*0 / 
     966       DATA (ijrnf(jc,122),jc=1,jpcoef)/294, 19*0 / 
     967       DATA (zrnfm(jm,122),jm=1,jpmois)/  & 
     968     &         16.,       0.,       0.,       0.,      95.,     337.,  & 
     969     &        488.,     453.,     285.,     143.,      84.,     109. / 
     970       ! 23- 
     971       ! --> 206m3/s 
     972       DATA inb(123)/1/ 
     973       DATA (iirnf(jc,123),jc=1,jpcoef)/32, 19*0 / 
     974       DATA (ijrnf(jc,123),jc=1,jpcoef)/294, 19*0 / 
     975       DATA (zrnfm(jm,123),jm=1,jpmois)/  & 
     976     &         12.,       0.,       0.,       0.,      35.,     400.,  & 
     977     &        652.,     616.,     347.,     172.,     105.,     144. / 
     978       ! 24- Ganga + Brahmaputra (Bangladesh) 22N00  91E00 
     979       ! --> 42436m3/s 
     980       DATA inb(124)/9/ 
     981       DATA (iirnf(jc,124),jc=1,jpcoef)/ 37, 38, 39, 32, 33, 34, 35  & 
     982     &      , 36, 37, 11*0 / 
     983       DATA (ijrnf(jc,124),jc=1,jpcoef)/ 295,295,295,294,294,294,294  & 
     984     &      , 294, 294, 11*0 / 
     985       DATA (zrnfm(jm,124),jm=1,jpmois)/  & 
     986     &        14293.,   4223.,   3004.,  11743.,  32210.,  56899.,  & 
     987     &        82263.,  95069.,  77997.,  44194.,  23724.,  17272. / 
     988 
     989       DATA inb(125)/0/ 
     990      DATA inb(126)/0/ 
     991 
     992       ! 27- Kuladan 
     993       ! --> 1541m3/s 
     994       DATA inb(127)/1/ 
     995       DATA (iirnf(jc,127),jc=1,jpcoef)/42, 19*0 / 
     996       DATA (ijrnf(jc,127),jc=1,jpcoef)/290, 19*0 / 
     997       DATA (zrnfm(jm,127),jm=1,jpmois)/  & 
     998     &        140.,       0.,       0.,      27.,    2280.,    4133.,  & 
     999     &       4306.,    3049.,    1993.,    1115.,     646.,     812. / 
     1000       ! 28- 
     1001       ! --> 618m3/s 
     1002       DATA inb(128)/1/ 
     1003       DATA (iirnf(jc,128),jc=1,jpcoef)/44, 19*0 / 
     1004       DATA (ijrnf(jc,128),jc=1,jpcoef)/287, 19*0 / 
     1005       DATA (zrnfm(jm,128),jm=1,jpmois)/  & 
     1006     &        0.,       0.,       0.,      73.,    1139.,    1755.,  & 
     1007     &      1725.,    1139.,     677.,     362.,     221.,     326. / 
     1008       ! 29- 
     1009       ! --> 158m3/s 
     1010       DATA inb(129)/1/ 
     1011       DATA (iirnf(jc,129),jc=1,jpcoef)/44, 19*0 / 
     1012       DATA (ijrnf(jc,129),jc=1,jpcoef)/284, 19*0 / 
     1013       DATA (zrnfm(jm,129),jm=1,jpmois)/  & 
     1014     &        0.,       0.,       0.,       0.,     248.,     419.,  & 
     1015     &      445.,     334.,     201.,     103.,      63.,      93. / 
     1016       ! 30- 
     1017       ! --> 136m3/s 
     1018       DATA inb(130)/1/ 
     1019       DATA (iirnf(jc,130),jc=1,jpcoef)/32, 19*0 / 
     1020       DATA (ijrnf(jc,130),jc=1,jpcoef)/277, 19*0 / 
     1021       DATA (zrnfm(jm,130),jm=1,jpmois)/  & 
     1022     &         0.,       0.,       0.,       0.,     223.,     261.,  & 
     1023     &       269.,     315.,     223.,     147.,      86.,     116. / 
     1024       ! 31- 
     1025       ! --> 142m3/s 
     1026       DATA inb(131)/1/ 
     1027       DATA (iirnf(jc,131),jc=1,jpcoef)/42, 19*0 / 
     1028       DATA (ijrnf(jc,131),jc=1,jpcoef)/275, 19*0 / 
     1029       DATA (zrnfm(jm,131),jm=1,jpmois)/  & 
     1030     &         0.,       0.,       0.,       0.,     241.,     260.,  & 
     1031     &       270.,     325.,     231.,     158.,      96.,     126.  / 
     1032       ! 32- Irrawady (Myanmar) 15N50  95E06 
     1033       ! --> 16751m3/s 
     1034       DATA inb(132)/3/ 
     1035       DATA (iirnf(jc,132),jc=1,jpcoef)/  45,  46, 47, 17*0 / 
     1036       DATA (ijrnf(jc,132),jc=1,jpcoef)/ 282, 281, 282, 17*0 / 
     1037       DATA (zrnfm(jm,132),jm=1,jpmois)/  & 
     1038     &       7174.,     2281.,     80.,    687.,    8133.,   23980.,  & 
     1039     &       38452.,   41442.,  34497.,  23150.,   12529.,    8629. / 
     1040 
     1041       DATA inb(133)/0/ 
     1042       DATA inb(134)/0/ 
     1043       DATA inb(135)/0/ 
     1044       DATA inb(136)/0/ 
     1045 
     1046       ! 37- Tenasserim (Myanmar) 
     1047       ! --> 1369m3/s 
     1048       DATA inb(137)/1/ 
     1049       DATA (iirnf(jc,137),jc=1,jpcoef)/51, 19*0 / 
     1050       DATA (ijrnf(jc,137),jc=1,jpcoef)/279, 19*0 / 
     1051       DATA (zrnfm(jm,137),jm=1,jpmois)/  & 
     1052     &        65.,       0.,       0.,     540.,    2127.,    3260.,  & 
     1053     &      3540.,    2966.,    1747.,     900.,     544.,     741. / 
     1054       ! 38- 
     1055       ! --> 413m3/s 
     1056       DATA inb(138)/1/ 
     1057       DATA (iirnf(jc,138),jc=1,jpcoef)/52, 19*0 / 
     1058       DATA (ijrnf(jc,138),jc=1,jpcoef)/277, 19*0 / 
     1059       DATA (zrnfm(jm,138),jm=1,jpmois)/  & 
     1060     &          0.,       0.,       0.,     202.,     773.,    1000.,  & 
     1061     &       1032.,     831.,     492.,     248.,     153.,     226. / 
     1062       ! 39- 
     1063       ! --> 810m3/s 
     1064       DATA inb(139)/1/ 
     1065       DATA (iirnf(jc,139),jc=1,jpcoef)/52, 19*0 / 
     1066       DATA (ijrnf(jc,139),jc=1,jpcoef)/275, 19*0 / 
     1067       DATA (zrnfm(jm,139),jm=1,jpmois)/  & 
     1068     &         59.,       0.,       0.,      22.,    1104.,    1857.,  & 
     1069     &       2069.,    1858.,    1252.,     637.,     373.,     493. / 
     1070       ! 40- 
     1071       ! --> 896m3/s 
     1072       DATA inb(140)/1/ 
     1073       DATA (iirnf(jc,140),jc=1,jpcoef)/52, 19*0 / 
     1074       DATA (ijrnf(jc,140),jc=1,jpcoef)/273, 19*0 / 
     1075       DATA (zrnfm(jm,140),jm=1,jpmois)/  & 
     1076     &         94.,       0.,       0.,     196.,    1145.,    1716.,  & 
     1077     &       1936.,    1899.,    1519.,    1000.,     562.,     688. / 
     1078       ! 41- 
     1079       ! --> 559m3/s 
     1080       DATA inb(141)/1/ 
     1081       DATA (iirnf(jc,141),jc=1,jpcoef)/52, 19*0 / 
     1082       DATA (ijrnf(jc,141),jc=1,jpcoef)/271, 19*0 / 
     1083       DATA (zrnfm(jm,141),jm=1,jpmois)/  & 
     1084     &       38.,       0.,       0.,     227.,     805.,    1051.,  & 
     1085     &      1105.,    1236.,     941.,     575.,     321.,     416. / 
     1086       ! 42- 
     1087       ! --> 1070m3/s 
     1088       DATA inb(142)/1/ 
     1089       DATA (iirnf(jc,142),jc=1,jpcoef)/53, 19*0 / 
     1090       DATA (ijrnf(jc,142),jc=1,jpcoef)/265, 19*0 / 
     1091       DATA (zrnfm(jm,142),jm=1,jpmois)/  & 
     1092     &       356.,      18.,      14.,     160.,     745.,    1123.,  & 
     1093     &      1347.,    1732.,    2076.,    2057.,    1574.,    1639. / 
     1094       ! 43- 
     1095       ! --> 513m3/s 
     1096       DATA inb(143)/1/ 
     1097       DATA (iirnf(jc,143),jc=1,jpcoef)/54, 19*0 / 
     1098       DATA (ijrnf(jc,143),jc=1,jpcoef)/263, 19*0 / 
     1099       DATA (zrnfm(jm,143),jm=1,jpmois)/  & 
     1100     &       231.,      12.,     121.,     236.,     216.,     239.,  & 
     1101     &       351.,     517.,    1008.,    1324.,     975.,     929.  / 
     1102       ! 44- 
     1103       ! --> 881m3/s 
     1104       DATA inb(144)/1/ 
     1105       DATA (iirnf(jc,144),jc=1,jpcoef)/56, 19*0 / 
     1106       DATA (ijrnf(jc,144),jc=1,jpcoef)/259, 19*0 / 
     1107       DATA (zrnfm(jm,144),jm=1,jpmois)/  & 
     1108     &      558.,     632.,     980.,     902.,     575.,     421.,  & 
     1109     &      432.,     731.,    1276.,    1405.,    1188.,    1480. / 
     1110       ! 45- 
     1111       ! --> 905m3/s 
     1112       DATA inb(145)/1/ 
     1113       DATA (iirnf(jc,145),jc=1,jpcoef)/52, 19*0 / 
     1114       DATA (ijrnf(jc,145),jc=1,jpcoef)/259, 19*0 / 
     1115       DATA (zrnfm(jm,145),jm=1,jpmois)/  & 
     1116     &      604.,     552.,     781.,     853.,     627.,     488.,  & 
     1117     &      503.,     781.,    1245.,    1356.,    1331.,    1747. / 
     1118       ! 46- 
     1119       ! --> 136m3/s 
     1120       DATA inb(146)/1/ 
     1121       DATA (iirnf(jc,146),jc=1,jpcoef)/50, 19*0 / 
     1122       DATA (ijrnf(jc,146),jc=1,jpcoef)/261, 19*0 / 
     1123       DATA (zrnfm(jm,146),jm=1,jpmois)/  & 
     1124     &      103.,     111.,     126.,     112.,      66.,      40.,  & 
     1125     &       35.,      51.,     126.,     227.,     279.,     362.  / 
     1126       ! 47- 
     1127       ! --> 222m3/s 
     1128       DATA inb(147)/1/ 
     1129       DATA (iirnf(jc,147),jc=1,jpcoef)/47, 19*0 / 
     1130       DATA (ijrnf(jc,147),jc=1,jpcoef)/258, 19*0 / 
     1131       DATA (zrnfm(jm,147),jm=1,jpmois)/  & 
     1132     &      176.,     160.,     209.,     197.,     130.,      99.,  & 
     1133     &       90.,     151.,     240.,     342.,     373.,     502./ 
     1134       ! 48- 
     1135       ! --> 326m3/s 
     1136       DATA inb(148)/1/ 
     1137       DATA (iirnf(jc,148),jc=1,jpcoef)/49, 19*0 / 
     1138       DATA (ijrnf(jc,148),jc=1,jpcoef)/257, 19*0 / 
     1139       DATA (zrnfm(jm,148),jm=1,jpmois)/  & 
     1140     &       226.,     278.,     363.,     301.,     181.,     130.,  & 
     1141     &       131.,     194.,     407.,     505.,     519.,     689. / 
     1142       ! 49- 
     1143       ! --> 203m3/s 
     1144       DATA inb(149)/1/ 
     1145       DATA (iirnf(jc,149),jc=1,jpcoef)/50, 19*0 / 
     1146       DATA (ijrnf(jc,149),jc=1,jpcoef)/256, 19*0 / 
     1147       DATA (zrnfm(jm,149),jm=1,jpmois)/  & 
     1148     &      120.,     218.,     233.,     189.,     134.,     128.,  & 
     1149     &      115.,     178.,     244.,     272.,     247.,     360. / 
     1150       ! 50- 
     1151       ! --> 153m3/s 
     1152       DATA inb(150)/1/ 
     1153       DATA (iirnf(jc,150),jc=1,jpcoef)/50, 19*0 / 
     1154       DATA (ijrnf(jc,150),jc=1,jpcoef)/255, 19*0 / 
     1155       DATA (zrnfm(jm,150),jm=1,jpmois)/  & 
     1156     &         97.,     108.,     191.,     141.,      97.,      82.,  & 
     1157     &        107.,     118.,     188.,     230.,     208.,     278. / 
     1158       ! 51- 
     1159       ! --> 196m3/s 
     1160       DATA inb(151)/1/ 
     1161       DATA (iirnf(jc,151),jc=1,jpcoef)/53, 19*0 / 
     1162       DATA (ijrnf(jc,151),jc=1,jpcoef)/253, 19*0 / 
     1163       DATA (zrnfm(jm,151),jm=1,jpmois)/  & 
     1164     &        74.,     125.,     165.,     123.,     117.,     121.,  & 
     1165     &       160.,     196.,     272.,     322.,     296.,     389. / 
     1166       ! 52- 
     1167       ! --> 166m3/s 
     1168       DATA inb(152)/1/ 
     1169       DATA (iirnf(jc,152),jc=1,jpcoef)/53, 19*0 / 
     1170       DATA (ijrnf(jc,152),jc=1,jpcoef)/252, 19*0 / 
     1171       DATA (zrnfm(jm,152),jm=1,jpmois)/  & 
     1172     &      136.,     140.,     192.,     169.,     108.,      80.,  & 
     1173     &      75.,     145.,     200.,     219.,     221.,     307. / 
     1174       ! 53-Tigris+Euphrates (Irak) 31N00  47E25 
     1175       ! --> 4762m3/s 
     1176       DATA inb(153)/3/ 
     1177       DATA (iirnf(jc,153),jc=1,jpcoef)/ 673, 673, 674, 17*0 / 
     1178       DATA (ijrnf(jc,153),jc=1,jpcoef)/ 312, 313, 313, 17*0 / 
     1179       DATA (zrnfm(jm,153),jm=1,jpmois)/  & 
     1180     &       6056.,    7229.,    8377.,    8505.,    7966.,    6217.,  & 
     1181     &       3396.,    1898.,    1147.,     869.,    1714.,    3779. / 
     1182 
     1183       DATA (inb(jr),jr=154,200)/47*0/ 
     1184 
    8231185 
    8241186      !  Total run-offs(VII)=6181.33301m3/s 
    … …  
    8281190      !                                      = 0.567083955 Sverdrup 
    8291191 
    830       DATA (inb(jr),jr=103,jpriv)/18*0/ 
    831        
    8321192      !!---------------------------------------------------------------------- 
    8331193      !!  OPA 8.5, LODYC-IPSL (2002) 
    … …  
    8711231 
    8721232         iman  = jpmois 
    873           
     1233 !!! better but change the results      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    8741234         i15 = nday / 16 
    875           
    8761235         imois = nmonth + i15 - 1 
    8771236         IF( imois == 0) imois = iman 
    … …  
    10911450                     ! ji+2,jj+2 
    10921451                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2) 
    1093                         DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1) 
     1452                        DO ji = mi0(iirnf(jl,jr) + 2), mi1(iirnf(jl,jr) + 2) 
    10941453                           DO jn = 1, 3   
    10951454                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) ) 

  • trunk/NEMO/OPA_SRC/SBC/ocesbc.F90

    r440 r473  
    174174   END SUBROUTINE oce_sbc 
    175175 
    176 # elif defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
     176# elif defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
    177177      !!---------------------------------------------------------------------- 
    178178      !!   'key_ice_lim'                              with  LIM sea-ice model 
    … …  
    373373 
    374374   END SUBROUTINE oce_sbc 
    375  
    376 # elif defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily 
     375# elif defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily || defined key_flx_core 
    377376      !!------------------------------------------------------------------------- 
    378377      !!   'key_flx_bulk_monthly' or 'key_flx_bulk_daily' or        bulk formulea 
    … …  
    418417      !!---------------------------------------------------------------------- 
    419418  
     419 
     420#if defined key_flx_core 
     421      CALL ctl_stop( 'flxcore and no ice model not tested yet' ) 
     422#endif 
     423 
    420424      ! 1. initialization to zero at kt = nit000 
    421425      ! --------------------------------------- 

  • trunk/NEMO/OPA_SRC/SBC/tau_forced_daily.h90

    r392 r473  
    1010      numtau,         &  ! logical unit for the i-component of the wind data 
    1111      numtav,         &  ! logical unit for the j-component of the wind data 
    12       ntau1, ntau2 ,  &  ! index of the first and second record used 
    1312      ndaytau            ! new day for ers/ncep tau forcing 
    1413 
    15    CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields 
    16       cl_taux ,  & ! generic name of the i-component monthly NetCDF file 
    17       cl_tauy      ! generic name of the j-component monthly NetCDF file 
    1814   !!---------------------------------------------------------------------- 
    1915   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    4743      !!        !  03-07  (C. Ethe, G. Madec)  daily generic forcing 
    4844      !!---------------------------------------------------------------------- 
    49       !! * Modules used 
    50       USE ioipsl       ! NetCDF library 
     45      USE iom       ! NetCDF library 
    5146 
    52       !! * Arguments 
    5347      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    54  
    55       !! * Local declarations 
    56       INTEGER, PARAMETER ::   jpday = 365 
    57       INTEGER ::   & 
    58          itime,   & 
    59          iday, idy,   & 
    60          ipi, ipj, ipk 
    61       INTEGER  , DIMENSION(jpday)  ::   istep 
    62       REAL(wp) , DIMENSION(jpi,jpj)::  & 
    63          zlon  , &  
    64          zlat 
    65       REAL(wp) , DIMENSION(jpk)::  & 
    66          zlev 
    67       REAL(wp) ::   zsecond, zdate0 
     48      
    6849      !!--------------------------------------------------------------------- 
    69       cl_taux = 'taux.nc' 
    70       cl_tauy = 'tauy.nc' 
    71  
    72       ! -------------- ! 
    73       ! Initialization ! 
    74       ! -------------- ! 
    75  
    76       itime = jpday 
    77       ipi   = jpiglo 
    78       ipj   = jpjglo 
    79       ipk   = jpk 
    80       idy   = 365 
    81       IF ( nleapy == 1 ) idy = 366  
    82  
    8350 
    8451      ! -------------------- ! 
    … …  
    8754 
    8855      IF( kt == nit000 ) THEN 
     56          
     57         ndaytau = 0   ! initialization 
    8958         IF(lwp) THEN 
    9059            WRITE(numout,*) ' ' 
    9160            WRITE(numout,*) ' tau    : DAILY wind stress in NetCDF files' 
    92             WRITE(numout,*) ' ~~~~~~~' 
    9361         ENDIF 
    94          ! title, dimensions and tests 
    95 #if defined key_agrif 
    96       if ( .NOT. Agrif_Root() ) then 
    97          cl_taux = TRIM(Agrif_CFixed())//'_'//TRIM(cl_taux) 
    98       endif 
    99 #endif 
     62         ! open the files 
     63         CALL iom_open ( 'taux_1d.nc', numtau ) 
     64         CALL iom_open ( 'tauy_1d.nc', numtav ) 
    10065          
    101          CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid 
    102                         .FALSE., ipi   , ipj, ipk   ,        & 
    103                         zlon , zlat  , zlev   , itime,       & 
    104                         istep, zdate0, zsecond, numtau ) 
    105           
    106          IF( itime /= jpday .AND. itime /= jpday+1 ) THEN 
    107             IF(lwp) WRITE(numout,cform_err) 
    108             IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_taux 
    109             IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpday = ',jpday 
    110             nstop = nstop + 1 
    111          ENDIF 
    112          IF( ipi /= jpidta .OR. ipj /= jpjdta  ) THEN 
    113             IF(lwp) WRITE(numout,cform_err) 
    114             IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_taux 
    115             IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta 
    116             IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta 
    117             nstop = nstop + 1 
    118          ENDIF 
    119 #if defined key_agrif 
    120       if ( .NOT. Agrif_Root() ) then 
    121          cl_tauy = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tauy) 
    122       endif 
    123 #endif 
    124  
    125          CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid 
    126                         .FALSE., ipi   , ipj, ipk   ,        & 
    127                         zlon , zlat  , zlev   , itime,       & 
    128                         istep, zdate0, zsecond, numtav ) 
    129           
    130          IF( itime /= jpday .AND. itime /= jpday+1 ) THEN 
    131             IF(lwp) WRITE(numout,cform_err) 
    132             IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_tauy 
    133             IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpday = ',jpday 
    134             nstop = nstop + 1 
    135          ENDIF 
    136          IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 
    137             IF(lwp) WRITE(numout,cform_err) 
    138             IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_tauy 
    139             IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta 
    140             IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta 
    141             nstop = nstop + 1 
    142          ENDIF 
    14366      ENDIF 
    14467 
    … …  
    15073             
    15174         ndaytau = nday 
    152          iday  = nday_year 
    15375             
    15476         ! Read daily wind stress data 
    155          CALL flinget( numtau,'taux',                 &   ! taux: i-component at U-pt 
    156                        jpidta,jpjdta,1,jpday,iday,    & 
    157                        iday,mig(1),nlci,mjg(1),nlcj,taux(1:nlci,1:nlcj) ) 
    158          CALL flinget( numtav,'tauy',                 &   ! tauy: j-component at V-pt 
    159                        jpidta,jpjdta,1,jpday,iday,    & 
    160                        iday,mig(1),nlci,mjg(1),nlcj,tauy(1:nlci,1:nlcj) ) 
     77 
     78         CALL iom_get ( numtau, jpdom_data, 'taux', taux, nday_year ) 
     79         CALL iom_get ( numtav, jpdom_data, 'tauy', tauy, nday_year ) 
    16180             
    16281         IF (lwp .AND. nitend-nit000 <= 100 ) THEN 
    … …  
    185104      ! Closing of the 2 files 
    186105      IF( kt == nitend ) THEN 
    187           CALL flinclo( numtau ) 
    188           CALL flinclo( numtav ) 
     106          CALL iom_close( numtau ) 
     107          CALL iom_close( numtav ) 
    189108      ENDIF 
    190109          

  • trunk/NEMO/OPA_SRC/SBC/tau_forced_monthly.h90

    r392 r473  
    99   !! * local modules variables 
    1010   INTEGER ::   & 
    11       numtau,   &  ! logical unit for the i-component of the wind data 
    12       numtav,   &  ! logical unit for the j-component of the wind data 
     11      numtau,   &   ! logical unit for the i-component of the wind data 
     12      numtav,   &   ! logical unit for the j-component of the wind data 
    1313      ntau1, ntau2  ! index of the first and second record used 
    14  
    15    CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields 
    16       cl_taux,  & ! generic name of the i-component monthly NetCDF file 
    17       cl_tauy     ! generic name of the j-component monthly NetCDF file 
    18  
    1914   REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    2015      taux_dta,    &  ! i- and j-components of the surface stress (Pascal) 
    … …  
    5651      !!---------------------------------------------------------------------- 
    5752      !! * Modules used 
    58       USE ioipsl       ! NetCDF library 
     53      USE iom       
    5954      !! * Arguments 
    6055      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    6156 
    6257      !! * Local declarations 
    63       INTEGER, PARAMETER ::   jpmonth = 12 
    64       INTEGER ::   & 
    65          imois, iman, itime,   & 
    66          i15,   & 
    67          ipi, ipj, ipk 
    68       INTEGER, DIMENSION(jpmonth) ::   istep 
    69       REAL(wp) , DIMENSION(jpi,jpj)::  & 
    70          zlon  , & 
    71          zlat 
    72       REAL(wp) , DIMENSION(jpk)::  & 
    73          zlev 
    74       REAL(wp) ::   & 
    75          zsecond,   & ! ??? 
    76          zdate0,    & ! ??? 
    77          zxy          ! coefficient of the linear time interpolation 
     58      INTEGER :: imois, iman, i15 
     59      REAL(wp) :: zxy          ! coefficient of the linear time interpolation 
    7860      !!--------------------------------------------------------------------- 
    79       cl_taux = 'taux_1m.nc' 
    80       cl_tauy = 'tauy_1m.nc' 
    8161 
    8262      ! -------------- ! 
    … …  
    8666      ! iman=number of dates in data file (12 for a year of monthly values) 
    8767      iman  = INT( raamo ) 
    88       itime = jpmonth 
    89       ipi   = jpiglo 
    90       ipj   = jpjglo 
    91       ipk   = jpk 
    92  
    9368      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    94  
    9569      imois = nmonth + i15 - 1 
    9670      IF( imois == 0 ) imois = iman 
    97  
    9871 
    9972      ! -------------------- ! 
    … …  
    10275 
    10376      IF( kt == nit000 ) THEN 
    104          ntau1 = 0 
    105          IF(lwp) WRITE(numout,*) 
    106          IF(lwp) WRITE(numout,*) ' tau    : MONTHLY climatological wind stress (NetCDF files)' 
    107          IF(lwp) WRITE(numout,*) ' ~~~    ' 
    10877          
    109          ! title, dimensions and tests 
    110  
    111 #if defined key_agrif 
    112       if ( .NOT. Agrif_Root() ) then 
    113          cl_taux = TRIM(Agrif_CFixed())//'_'//TRIM(cl_taux) 
    114       endif 
    115 #endif 
     78         ntau1 = 0   ! initialization 
     79         IF(lwp) THEN 
     80            WRITE(numout,*) 
     81            WRITE(numout,*) ' tau    : MONTHLY climatological wind stress (NetCDF files)' 
     82         ENDIF 
     83         CALL iom_open ( 'taux_1m.nc', numtau ) 
     84         CALL iom_open ( 'tauy_1m.nc', numtav ) 
    11685          
    117          CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid 
    118                         .FALSE., ipi   , ipj, ipk   ,        & 
    119                         zlon , zlat  , zlev   , itime,       & 
    120                         istep, zdate0, zsecond, numtau ) 
    121           
    122          IF( itime /= jpmonth ) THEN 
    123             IF(lwp) WRITE(numout,cform_err) 
    124             IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_taux 
    125             IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpmonth = ',jpmonth 
    126             nstop = nstop + 1 
    127          ENDIF 
    128          IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN 
    129             IF(lwp) WRITE(numout,cform_err) 
    130             IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_taux 
    131             IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta 
    132             IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta 
    133             IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1' 
    134             nstop = nstop + 1 
    135          ENDIF 
    136 #if defined key_agrif 
    137       if ( .NOT. Agrif_Root() ) then 
    138          cl_tauy = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tauy) 
    139       endif 
    140 #endif 
    141          CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid 
    142                         .FALSE., ipi   , ipj, ipk   ,        & 
    143                         zlon , zlat  , zlev   , itime,       & 
    144                         istep, zdate0, zsecond, numtav ) 
    145  
    146          IF( itime /= jpmonth ) THEN           
    147             IF(lwp) WRITE(numout,cform_err) 
    148             IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_tauy 
    149             IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpmonth = ',jpmonth 
    150             nstop = nstop + 1 
    151          ENDIF 
    152          IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN 
    153             IF(lwp) WRITE(numout,cform_err) 
    154             IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_tauy 
    155             IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta 
    156             IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta 
    157             IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1' 
    158             nstop = nstop + 1 
    159          ENDIF 
    16086      ENDIF 
    16187       
    … …  
    178104         ! Read the corresponding 2 monthly stress data 
    179105         ! ntau1 
    180          CALL flinget( numtau,'sozotaux',    &               ! i-component at U-pt 
    181             jpidta,jpjdta,1,jpmonth,ntau1,   & 
    182             ntau1,mig(1),nlci,mjg(1),nlcj,taux_dta(1:nlci,1:nlcj,1) ) 
    183          CALL flinget( numtav,'sometauy',    &               ! j-component at V-pt 
    184             jpidta,jpjdta,1,jpmonth,ntau1,   & 
    185             ntau1,mig(1),nlci,mjg(1),nlcj,tauy_dta(1:nlci,1:nlcj,1) ) 
    186          ! ntau2 
    187          CALL flinget( numtau,'sozotaux',    &               ! i-component at U-pt 
    188             jpidta,jpjdta,1,jpmonth,ntau2,   & 
    189             ntau2,mig(1),nlci,mjg(1),nlcj,taux_dta(1:nlci,1:nlcj,2) ) 
    190          CALL flinget( numtav,'sometauy',    &               ! j-component at V-pt 
    191             jpidta,jpjdta,1,jpmonth,ntau2,   & 
    192             ntau2,mig(1),nlci,mjg(1),nlcj,tauy_dta(1:nlci,1:nlcj,2) ) 
     106         CALL iom_get ( numtau, jpdom_data, 'sozotaux', taux_dta(:,:,1), ntau1 ) 
     107         CALL iom_get ( numtav, jpdom_data, 'sometauy', tauy_dta(:,:,1), ntau1 ) 
     108 
     109         CALL iom_get ( numtau, jpdom_data, 'sozotaux', taux_dta(:,:,2), ntau2 ) 
     110         CALL iom_get ( numtav, jpdom_data, 'sometauy', tauy_dta(:,:,2), ntau2 ) 
    193111          
    194112         IF(lwp .AND. nitend-nit000 <= 100 ) THEN 
    … …  
    230148      ! Closing of the 2 files (required in mpp) 
    231149      IF( kt == nitend ) THEN 
    232           CALL flinclo(numtau) 
    233           CALL flinclo(numtav) 
     150          CALL iom_close(numtau) 
     151          CALL iom_close(numtav) 
    234152      ENDIF 
    235153 

  • trunk/NEMO/OPA_SRC/SOL/solisl.F90

    r352 r473  
    3939 
    4040   !! * module variable 
    41    INTEGER :: numisl = 11      ! logical unit for island file only used 
     41   INTEGER :: numisl           ! logical unit for island file only used 
    4242   !                           ! here during the initialization phase 
    4343   INTEGER ::   & 
    … …  
    248248 
    249249         IF( inilt == 0 ) THEN 
    250             IF(lwp) THEN 
    251                WRITE(numout,*) ' isldom: there is not island number: ', jnil,' while jpisl= ', jpisl 
    252                WRITE(numout,*) ' change parameter.h' 
    253             ENDIF 
    254             STOP 'isldom'      !cr replace by nstop 
     250            WRITE(ctmp1,*) ' isldom: there is not island number: ', jnil,' while jpisl= ', jpisl 
     251            CALL ctl_stop( ctmp1, ' change par_oce' ) 
     252 
    255253         ENDIF 
    256254          
    … …  
    381379          
    382380         IF( ip > jpnisl ) THEN 
    383             IF(lwp) THEN 
    384                WRITE(numout,*) ' isldom: the island ',jnil,' has ',   & 
    385                   mnisl(0,jnil),' grid-points, while jpnisl= ', jpnisl,ip 
    386                WRITE(numout,*) ' change parameter.h' 
    387             ENDIF 
    388             STOP 'isldom'    !cr => nstop 
     381            WRITE(ctmp1,*) ' isldom: the island ',jnil,' has ',   & 
     382                 mnisl(0,jnil),' grid-points, while jpnisl= ', jpnisl,ip 
     383            CALL ctl_stop( ctmp1, ' change par_oce.h' ) 
    389384         ENDIF 
    390385          
    … …  
    407402 
    408403      IF( inilt /= jpij+1 ) THEN 
    409          IF(lwp) THEN 
    410             WRITE(numout,*) ' isldom: there is at least one more ',   & 
     404            WRITE(ctmp1,*) ' isldom: there is at least one more ',   & 
    411405                  'island in the domain and jpisl=', jpisl 
    412             WRITE(numout,*) ' change parameter.h' 
    413          ENDIF 
    414          STOP 'isldom' 
     406            CALL ctl_stop( ctmp1, ' change par_oce.h' ) 
    415407      ENDIF 
    416408 
    … …  
    562554      !! * Modules used 
    563555      USE ioipsl 
     556      USE iom 
    564557       
    565558      !! * Local declarations 
    566       INTEGER ::   ji, jj, jni, jnj, jn, jl   ! dummy loop indices 
    567       INTEGER ::   itime, ibvar, ios          ! temporary integers 
    568       LOGICAL ::   llog 
    569       CHARACTER (len=32) ::   clname 
    570       CHARACTER (len=8 ) ::   clvnames(100) 
    571       REAL(wp), DIMENSION(1) ::   zdept 
    572       REAL(wp), DIMENSION(jpi,jpj) ::   zlamt, zphit 
     559      INTEGER ::   ji, jj, jni, jnj, jl   ! dummy loop indices 
     560      INTEGER ::   ios          ! temporary integers 
     561      INTEGER  ::   & 
     562         inum                 ! temporary logical unit 
    573563      REAL(wp), DIMENSION(jpi,jpj,2) ::   zwx 
    574564      REAL(wp), DIMENSION(jpisl*jpisl) ::   ztab 
    … …  
    580570 
    581571      ! Lecture 
    582       zlamt(:,:) = 0. 
    583       zphit(:,:) = 0. 
    584       zdept(1)   = 0. 
    585       itime = 0 
    586       clvnames="        " 
    587       clname = 'islands' 
    588       CALL ioget_vname(numisl, ibvar, clvnames) 
    589       IF(lwp) WRITE(numout,*) clvnames 
    590       ios=0 
    591       DO jn=1,100 
    592         IF(clvnames(jn) == 'aisl') ios=1 
    593       END DO 
    594       IF( ios == 0 ) go to 110  
    595  
    596       CALL restget( numisl, 'aisl'  , jpisl, jpisl, 1, 0, llog, aisl   ) 
    597       CALL restget( numisl, 'aislm1', jpisl, jpisl, 1, 0, llog, aislm1 ) 
    598       CALL restclo( numisl ) 
    599       ! Control print 
    600       IF(lwp) THEN 
    601          WRITE(numout,*) 
    602          WRITE(numout,*)' islmat: lecture aisl/aislm1 in numisl done' 
    603          WRITE(numout,*)' ~~~~~~' 
    604          WRITE(numout,*) 
    605          WRITE(numout,*) '        island matrix : ' 
    606          WRITE(numout,*) 
    607           
    608          DO jnj = 1, jpisl 
    609             WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl ) 
    610          END DO 
    611  
    612          WRITE(numout,*) 
    613          WRITE(numout,*) '       inverse of the island matrix' 
    614          WRITE(numout,*) 
    615  
    616          DO jnj = 1, jpisl 
    617             WRITE(numout,'(12e11.3)') ( aislm1(jni,jnj), jni=1,jpisl ) 
    618          END DO 
    619       ENDIF 
    620        
    621       RETURN 
    622  
    623  110  CONTINUE 
    624  
     572      CALL iom_open ( 'islands', inum ) 
     573      ios = iom_varid( inum, 'aisl' ) 
     574      IF( ios > 0 ) THEN 
     575 
     576         CALL iom_get( inum, jpdom_unknown, 'aisl'  , aisl )      
     577         CALL iom_get( inum, jpdom_unknown, 'aislm1', aislm1 )       
     578         CALL iom_close( inum ) 
     579         ! Control print 
     580         IF(lwp) THEN 
     581            WRITE(numout,*) 
     582            WRITE(numout,*)' islmat: lecture aisl/aislm1 in numisl done' 
     583            WRITE(numout,*)' ~~~~~~' 
     584            WRITE(numout,*) 
     585            WRITE(numout,*) '        island matrix : ' 
     586            WRITE(numout,*) 
     587             
     588            DO jnj = 1, jpisl 
     589               WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl ) 
     590            END DO 
     591             
     592            WRITE(numout,*) 
     593            WRITE(numout,*) '       inverse of the island matrix' 
     594            WRITE(numout,*) 
     595             
     596            DO jnj = 1, jpisl 
     597               WRITE(numout,'(12e11.3)') ( aislm1(jni,jnj), jni=1,jpisl ) 
     598            END DO 
     599         ENDIF 
     600  
     601         CALL restclo(numisl) 
     602                  
     603      ELSE 
     604  
     605         CALL iom_close( inum ) 
    625606 
    626607      ! II. Island matrix computation 
    … …  
    707688      CALL restput( numisl, 'aislm1', jpisl, jpisl, 1, 0, aislm1 ) 
    708689      CALL restclo( numisl ) 
     690 
     691      ENDIF 
    709692 
    710693   END SUBROUTINE isl_mat 
    … …  
    744727      !! * Modules used 
    745728      USE ioipsl 
     729      USE iom 
    746730      USE solpcg 
    747731      USE solfet 
    … …  
    751735      LOGICAL  ::   llog, llbon 
    752736      CHARACTER (len=10) ::  clisl 
    753       CHARACTER (len=32) ::  clname, clname2 
    754       INTEGER  ::   ji, jj, jni, jii, jnp, je   ! dummy loop indices 
     737      CHARACTER (len=32) ::  clname = 'islands' 
     738      INTEGER  ::   & 
     739         inum                 ! temporary logical unit 
     740      INTEGER  ::   ji, jj, jni, jii, jnp  ! dummy loop indices 
    755741      INTEGER  ::   iimlu, ijmlu, inmlu, iju 
    756742      INTEGER  ::   ii, ij, icile, icut, inmax, indic 
    757       INTEGER  ::   itime, ie 
     743      INTEGER  ::   itime 
    758744      REAL(wp) ::   zepsr, zeplu, zgwgt 
    759       REAL(wp) ::   zep(jpisl), zlamt(jpi,jpj), zphit(jpi,jpj), zdept(1), zprec(4) 
     745      REAL(wp) ::   zep(jpisl), zdept(1), zprec(4) 
    760746      REAL(wp) ::   zdate0, zdt 
    761747      REAL(wp) ::   t2p1(jpi,1,1) 
    … …  
    779765      inmlu = 0 
    780766      zeplu = 0. 
    781       zlamt(:,:) = 0. 
    782       zphit(:,:) = 0. 
    783       zdept(1)   = 0. 
    784       itime = 0 
     767       
    785768      clname = 'islands' 
    786       ie=1 
    787       DO je = 1, 32 
    788         IF( clname(je:je) /= ' ' ) ie = je 
    789       END DO 
    790       clname2 = clname(1:ie)//".nc" 
    791       INQUIRE( FILE=clname2, EXIST=llbon ) 
     769       
     770      INQUIRE( FILE=clname, EXIST=llbon ) 
    792771! islands FILE does not EXIST : icut=999 
    793772      IF( llbon ) THEN  
     773 
    794774         ! island FILE is present  
    795          CALL restini(clname,jpi,jpj,zlamt,zphit,1,zdept,  & 
    796             &         'NONE',itime,zdate0,zdt,numisl,domain_id=nidom) 
    797          CALL restget(numisl,'PRECISION',1,1,4,0,llog,zprec) 
     775 
     776         CALL iom_open (clname, inum ) 
     777         CALL iom_get( inum, jpdom_unknown, 'PRECISION', zprec )      
     778 
    798779         iimlu = NINT( zprec(1) ) 
    799780         ijmlu = NINT( zprec(2) ) 
    … …  
    803784         IF( iimlu /= jpi .OR. ijmlu /= jpj .OR. inmlu /= jpisl ) THEN 
    804785            icut = 999 
    805             CALL restclo(numisl) 
    806786         ELSE  
    807787            DO jni = 1, jpisl 
    … …  
    813793                  WRITE(clisl,'("island",I3)') jni 
    814794               ENDIF 
    815                CALL restget(numisl,clisl,jpi,jpj,1,0,llog, bsfisl(:,:,jni)) 
     795               CALL iom_get( inum, jpdom_local, clisl, bsfisl(:,:,jni))      
    816796            END DO 
    817797         ENDIF 
    … …  
    819799         ! islands FILE does not EXIST : icut=999  
    820800         icut = 999 
    821          CALL restclo(numisl) 
    822       ENDIF 
    823        
     801      ENDIF 
     802   
     803      CALL iom_close( inum ) 
     804     
    824805      ! the read precision is not the required one : icut=888 
    825806      IF( zeplu > epsisl ) THEN  
    826807         icut = 888 
    827          CALL restclo(numisl) 
    828808      ENDIF 
    829809 
    … …  
    10961076      zprec(3) = FLOAT(jpisl) 
    10971077      IF(lwp) WRITE(numout,*) clname 
     1078      zdept(1)   = 0. 
     1079      itime = 0 
    10981080      CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1, zdept,  & 
    10991081         &          clname, itime, zdate0, rdt, numisl, domain_id=nidom ) 
    … …  
    11501132         END DO 
    11511133         CALL restclo(numisl) 
    1152          nstop = nstop + 1 
     1134         CALL ctl_stop( ' ' ) 
    11531135      ENDIF 
    11541136 

  • trunk/NEMO/OPA_SRC/TRA/trabbc.F90

    r457 r473  
    137137      !!---------------------------------------------------------------------- 
    138138      !! * Modules used 
    139       USE ioipsl 
     139      USE iom 
    140140 
    141141      !! * local declarations 
    142       CHARACTER (len=32) ::   clname 
    143142      INTEGER  ::   ji, jj              ! dummy loop indices 
    144       INTEGER  ::   inum = 11           ! temporary logical unit 
    145       INTEGER  ::   itime               ! temporary integers 
    146       REAL(wp) ::   zdate0, zdt         ! temporary scalars 
    147       REAL(wp), DIMENSION(1) :: zdept   ! temporary workspace 
    148       REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    149          zlamt, zphit, zdta   ! temporary workspace 
     143      INTEGER  ::   inum                ! temporary logical unit 
    150144 
    151145      NAMELIST/nambbc/ngeo_flux, ngeo_flux_const  
    … …  
    188182      CASE ( 2 )                ! variable geothermal heat flux 
    189183         ! read the geothermal fluxes in mW/m2 
    190          clname = 'geothermal_heating' 
    191 #if defined key_agrif 
    192       if ( .NOT. Agrif_Root() ) then 
    193          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    194       endif 
    195 #endif     
    196          itime = 1 
    197          zlamt(:,:) = 0. 
    198          zphit(:,:) = 0. 
    199          IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux read in ', clname, ' file' 
    200          CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , 'NONE',   & 
    201             &          itime, zdate0, zdt, inum, domain_id=nidom ) 
    202          CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, itime, .FALSE., zdta ) 
    203          DO jj = 1, nlcj 
    204             DO ji = 1, nlci 
    205               qgh_trd(ji,jj) = zdta(mig(ji),mjg(jj)) 
    206             END DO 
    207          END DO 
    208  
    209          CALL restclo( inum ) 
     184 
     185         IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux' 
     186         CALL iom_open ( 'geothermal_heating.nc', inum ) 
     187         CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd ) 
     188         CALL iom_close (inum) 
     189 
    210190         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2 
    211191 
    212192      CASE DEFAULT 
    213          IF(lwp) WRITE(numout,cform_err) 
    214          IF(lwp) WRITE(numout,*) '     bad flag value for ngeo_flux = ', ngeo_flux 
    215          nstop = nstop + 1 
    216  
     193         WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux 
     194         CALL ctl_stop( ctmp1 ) 
    217195      END SELECT 
    218196 

  • trunk/NEMO/OPA_SRC/TRA/tradmp.F90

    r457 r473  
    244244 
    245245      CASE DEFAULT 
    246          IF(lwp) WRITE(numout,cform_err) 
    247          IF(lwp) WRITE(numout,*) '          bad flag value for ndmp = ', ndmp 
    248          nstop = nstop + 1 
     246         WRITE(ctmp1,*) '          bad flag value for ndmp = ', ndmp 
     247         CALL ctl_stop(ctmp1) 
    249248 
    250249      END SELECT 
    … …  
    263262 
    264263      CASE DEFAULT 
    265          IF(lwp) WRITE(numout,cform_err) 
    266          IF(lwp) WRITE(numout,*) '          bad flag value for nmldmp = ', nmldmp 
    267          nstop = nstop + 1 
     264         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmp 
     265         CALL ctl_stop(ctmp1) 
    268266 
    269267      END SELECT 
    270268 
    271       IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem ) THEN 
    272          IF(lwp) WRITE(numout,cform_err) 
    273          IF(lwp) WRITE(numout,*) '          no temperature and/or salinity data ' 
    274          IF(lwp) WRITE(numout,*) '          define key_dtatem and key_dtasal' 
    275          nstop = nstop + 1 
    276       ENDIF 
    277  
     269      IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem ) & 
     270           &   CALL ctl_stop( '          no temperature and/or salinity data ', & 
     271           &                  '          define key_dtatem and key_dtasal' ) 
    278272 
    279273      strdmp(:,:,:) = 0.e0       ! internal damping salinity trend (used in ocesbc) 
    … …  
    398392      !!---------------------------------------------------------------------- 
    399393      !! * Modules used 
     394      USE iom 
    400395      USE ioipsl 
    401396 
    402397      !! * Local declarations 
    403       INTEGER ::   ji, jj, jk, je      ! dummy loop indices 
    404       INTEGER, PARAMETER ::   jpmois=1 
    405       INTEGER ::   ipi, ipj, ipk       ! temporary integers 
     398      INTEGER ::   ji, jj, jk     ! dummy loop indices 
     399      INTEGER ::   itime 
    406400      INTEGER ::   ii0, ii1, ij0, ij1  !    "          " 
    407401      INTEGER ::   & 
    408402         idmp,     &  ! logical unit for file restoring damping term 
    409403         icot         ! logical unit for file distance to the coast 
    410       INTEGER :: itime, istep(jpmois), ie 
    411       LOGICAL :: llbon 
    412       CHARACTER (len=32) ::  clname, clname2, clname3 
     404      CHARACTER (len=32) :: clname3 
    413405      REAL(wp) ::   & 
    414406         zdate0, zinfl, zlon,         & ! temporary scalars 
    … …  
    416408         zsdmp, zbdmp                   !    "         " 
    417409      REAL(wp), DIMENSION(jpk) ::   & 
    418          zdept, zhfac 
     410         zhfac 
    419411      REAL(wp), DIMENSION(jpi,jpj) ::   & 
    420          zmrs, zlamt, zphit 
     412         zmrs 
    421413      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    422414         zdct 
    … …  
    435427      !   resto()     : array of restoring coeff. on T and S 
    436428 
    437       zdct (:,:,:) = 0.e0 
    438429      resto(:,:,:) = 0.e0 
    439430 
    … …  
    450441         ! ... Distance to coast (zdct) 
    451442 
    452          !   ... Test the existance of distance-to-coast file 
    453          itime = jpmois 
    454          ipi = jpiglo 
    455          ipj = jpjglo 
    456          ipk = jpk 
    457          clname = 'dist.coast' 
    458          DO je = 1,32 
    459             IF( clname(je:je) == ' ' ) go to 140 
    460          END DO 
    461 140      CONTINUE 
    462          ie = je 
    463          clname2 = clname(1:ie-1)//".nc" 
    464          inquire( FILE = clname2, EXIST = llbon ) 
    465  
    466          IF ( llbon ) THEN 
    467  
    468             !   ... Read file distance to coast if possible 
    469             CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .false.,   & 
    470                ipi, ipj, ipk, zlamt, zphit, zdept, jpmois,   & 
    471                istep, zdate0, rdt, icot ) 
    472             CALL flinget( icot, 'Tcoast', jpidta, jpjdta, jpk,    & 
    473                jpmois, 1, 1, mig(1), nlci, mjg(1), nlcj, zdct(1:nlci,1:nlcj,1:jpk) ) 
    474             CALL flinclo( icot ) 
    475             IF(lwp)WRITE(numout,*) '    ** : File dist.coast.nc read' 
    476  
     443         IF(lwp) WRITE(numout,*) 
     444         IF(lwp) WRITE(numout,*) ' dtacof : distance to coast file' 
     445         CALL iom_open ( 'dist.coast.nc', icot ) 
     446         IF( icot > 0 ) THEN 
     447            CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct ) 
     448            CALL iom_close (icot) 
    477449         ELSE 
    478  
    479450            !   ... Compute and save the distance-to-coast array (output in zdct) 
    480             CALL cofdis ( zdct ) 
    481  
     451            CALL cofdis( zdct ) 
    482452         ENDIF 
    483453 
    … …  
    642612         CASE ( 025 )                               !  ORCA_R025 configuration  
    643613            !                                       ! ======================== 
    644             IF(lwp) WRITE(numout,cform_err) 
    645             IF(lwp) WRITE(numout,*)' Not yet implemented in ORCA_R025' 
    646             nstop = nstop + 1 
     614            CALL ctl_stop( ' Not yet implemented in ORCA_R025' ) 
    647615 
    648616         END SELECT 
    … …  
    661629         !     No damping 
    662630         !    ------------ 
    663          IF(lwp) WRITE(numout,cform_err) 
    664          IF(lwp) WRITE(numout,*) 'Choose a correct value of ndmp or DO NOT defined key_tradmp' 
    665          nstop = nstop + 1 
     631         CALL ctl_stop( 'Choose a correct value of ndmp or DO NOT defined key_tradmp' ) 
    666632      ENDIF 
    667633 
    … …  
    676642         itime   = 0 
    677643         clname3 = 'damping.coeff' 
    678          CALL ymds2ju( 0     , 1     , 1      , 0.e0 , zdate0 ) 
    679          CALL restini( 'NONE', jpi   , jpj    , glamt, gphit,    & 
    680                        jpk   , gdept_0 , clname3, itime, zdate0,   & 
     644         CALL ymds2ju( 0     , 1      , 1      , 0.e0 , zdate0 ) 
     645         CALL restini( 'NONE', jpi    , jpj    , glamt, gphit,    & 
     646                       jpk   , gdept_0, clname3, itime, zdate0,   & 
    681647                       rdt   , idmp, domain_id=nidom ) 
    682648         CALL restput( idmp, 'Resto', jpi, jpj, jpk,   & 
    … …  
    688654 
    689655 
    690    SUBROUTINE cofdis ( pdct ) 
     656   SUBROUTINE cofdis( pdct ) 
    691657      !!---------------------------------------------------------------------- 
    692658      !!                 ***  ROUTINE cofdis  *** 
    … …  
    743709      IF(lwp) WRITE(numout,*) '~~~~~~' 
    744710      IF(lwp) WRITE(numout,*) 
    745       IF( lk_mpp ) THEN 
    746          IF(lwp) WRITE(numout,cform_err) 
    747          IF(lwp) WRITE(numout,*) '         Computation not yet implemented with key_mpp_...' 
    748          IF(lwp) WRITE(numout,*) '         Rerun the code on another computer or ' 
    749          IF(lwp) WRITE(numout,*) '         create the "dist.coast.nc" file using IDL' 
    750          nstop = nstop + 1 
    751       ENDIF 
     711      IF( lk_mpp ) & 
     712           & CALL ctl_stop('         Computation not yet implemented with key_mpp_...', & 
     713           &               '         Rerun the code on another computer or ', & 
     714           &               '         create the "dist.coast.nc" file using IDL' ) 
    752715 
    753716      pdct(:,:,:) = 0.e0 
    … …  
    800763               iju = jpi - ji + 1 
    801764               llcotu(ji,jpj  ) = llcotu(iju,jpj-2) 
    802                llcotf(ji,jpj-1) = llcotf(iju,jpj-2) 
     765               llcotf(ji,jpjm1) = llcotf(iju,jpj-2) 
    803766               llcotf(ji,jpj  ) = llcotf(iju,jpj-3) 
    804767            END DO 
    805             DO ji = jpi/2, jpi-1 
     768            DO ji = jpi/2, jpim1 
    806769               iju = jpi - ji + 1 
    807770               llcotu(ji,jpjm1) = llcotu(iju,jpjm1) 
    … …  
    809772            DO ji = 2, jpi 
    810773               ijt = jpi - ji + 2 
    811                llcotv(ji,jpj-1) = llcotv(ijt,jpj-2) 
     774               llcotv(ji,jpjm1) = llcotv(ijt,jpj-2) 
    812775               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3) 
    813776            END DO 
    … …  
    816779            DO ji = 1, jpim1 
    817780               iju = jpi - ji 
    818                llcotu(ji,jpj  ) = llcotu(iju,jpj-1) 
     781               llcotu(ji,jpj  ) = llcotu(iju,jpjm1) 
    819782               llcotf(ji,jpj  ) = llcotf(iju,jpj-2) 
    820783            END DO 
    821             DO ji = jpi/2, jpi-1 
     784            DO ji = jpi/2, jpim1 
    822785               iju = jpi - ji 
    823786               llcotf(ji,jpjm1) = llcotf(iju,jpjm1) 
    … …  
    825788            DO ji = 1, jpi 
    826789               ijt = jpi - ji + 1 
    827                llcotv(ji,jpj  ) = llcotv(ijt,jpj-1) 
     790               llcotv(ji,jpj  ) = llcotv(ijt,jpjm1) 
    828791            END DO 
    829792            DO ji = jpi/2+1, jpi 
    … …  
    885848      clname = 'dist.coast' 
    886849      itime = 0 
    887       CALL ymds2ju( 0     , 1     , 1     , 0.e0 , zdate0 ) 
    888       CALL restini( 'NONE', jpi   , jpj   , glamt, gphit ,   & 
    889                     jpk   , gdept_0 , clname, itime, zdate0,   & 
     850      CALL ymds2ju( 0     , 1      , 1     , 0.e0 , zdate0 ) 
     851      CALL restini( 'NONE', jpi    , jpj   , glamt, gphit ,   & 
     852                    jpk   , gdept_0, clname, itime, zdate0,   & 
    890853                    rdt   , icot                         ) 
    891854      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct ) 

  • trunk/NEMO/OPA_SRC/istate.F90

    r467 r473  
    5757      !!   9.0  !  03-09  (G. Madec)  F90: Free form, modules, orthogonality 
    5858      !!---------------------------------------------------------------------- 
     59      USE iom 
    5960      !! * Local declarations 
     61      !CT INTEGER ::   inum 
    6062      !!---------------------------------------------------------------------- 
    6163 
    … …  
    106108         ELSE 
    107109         !                                       ! Other configurations: Initial temperature and salinity fields 
     110 
     111         !CT CALL iom_open ('ssh', inum)  
     112         !CT CALL iom_get( inum, jpdom_local, 'sshb', sshb )     ! free surface formulation (ssh) 
     113         !CT sshn(:,:) = sshb(:,:) 
     114         !CT CALL iom_close (inum) 
     115 
    108116#if defined key_dtatem 
    109117            CALL dta_tem( nit000 )                  ! read 3D temperature data 
    … …  
    225233      USE eosbn2     ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    226234      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine) 
    227       USE ioipsl 
     235      USE iom 
    228236  
    229237      !! * Local declarations 
    230       LOGICAL :: llog 
    231       CHARACTER (len=21) ::   & 
    232          clname = 'eel.initemp',   &  ! filename (for EEL R2 or R6) 
    233          clvar  = 'initemp'           ! variable name 
    234238      INTEGER  ::   inum              ! temporary logical unit 
    235239      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    236       INTEGER  ::   ilev, itime       ! temporary integers 
    237240      REAL(wp) ::   & 
    238241         zh1, zh2, zslope, zcst       ! temporary scalars 
    … …  
    241244         zt2  =  2._wp,            &  ! bottom  temperature value (EEL R5) 
    242245         zsal = 35.5_wp                ! constant salinity (EEL R2, R5 and R6) 
    243       REAL(wp) ::   & 
    244          zdt,  zdate0                 ! temporary scalars 
    245       REAL(wp), DIMENSION(jpk) ::  & 
    246          zdept                        ! temporary workspace 
    247       REAL(wp), DIMENSION(jpiglo,jpjglo) ::   & 
    248          zlamt, zphit                 ! temporary workspace 
    249246# if ! defined key_dynspg_rl 
    250247      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   & 
    … …  
    328325            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    329326 
    330             itime  = 0 
    331             clname = 'eel.initemp' 
    332 #if defined key_agrif 
    333       if ( .NOT. Agrif_Root() ) then 
    334          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    335       endif 
    336 #endif                 
    337             llog   = .FALSE. 
    338             ilev   = jpk 
    339             zlamt(:,:) = 0.e0 
    340             zphit(:,:) = 0.e0 
    341             CALL restini( clname, jpidta, jpjdta, zlamt , zphit ,   & 
    342                &          ilev  , zdept , clname, itime , zdate0,   & 
    343                &          zdt   , inum  , domain_id=nidom ) 
    344             CALL restget( inum  , 'initemp', jpi, jpj, jpk,   & 
    345                &          0     , llog     , tb             )     ! read before temprature (tb) 
    346             CALL restclo( inum ) 
    347   
    348             tn(:,:,:) = tb(:,:,:)                                 ! set nox temperature to tb 
    349  
    350             IF(lwp) WRITE(numout,*) '               file name : ', clname 
     327            CALL iom_open ( 'eel.initemp', inum ) 
     328            CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb) 
     329            CALL iom_close( inum ) 
     330      
     331            tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb 
     332 
    351333            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    352334               &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    … …  
    375357         CASE DEFAULT                            ! NONE existing configuration 
    376358            !                                    ! =========================== 
    377             IF(lwp) WRITE(numout,cform_err)  
    378             IF(lwp) WRITE(numout,*) 'EEL with a ', jp_cfg,' km resolution is not coded' 
    379             nstop = nstop +1 
     359            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded' 
     360            CALL ctl_stop( ctmp1 ) 
     361 
    380362      END SELECT 
    381363 
    … …  
    397379      !!---------------------------------------------------------------------- 
    398380      !! * Modules used 
    399       USE ioipsl 
     381      USE iom 
    400382 
    401383      !! * Local variables 
    402       INTEGER, PARAMETER ::   jpmois = 12 
     384      INTEGER  ::   inum              ! temporary logical unit 
    403385      INTEGER, PARAMETER ::   & 
    404386         ntsinit = 0         ! (0/1) (analytical/input data files) T&S initialization 
    405387 
    406       CHARACTER (len=32) ::   clname 
    407       INTEGER :: ji, jj, jk                       ! dummy loop indices 
    408       INTEGER ::   ipi, ipj, ipk, itime           ! temporary integers 
    409       INTEGER, DIMENSION(jpmois) ::   istep 
    410  
    411       REAL(wp) ::   zdate0, zdt 
    412       REAL(wp), DIMENSION(jpk) ::   zlev 
    413       REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat 
    414       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zt_dta, zs_dta 
     388      INTEGER :: ji, jj, jk  ! dummy loop indices 
    415389      !!---------------------------------------------------------------------- 
    416390 
    … …  
    455429         ! Read temperature field 
    456430         ! ---------------------- 
    457          ! open file 
    458          zdt = rdt 
    459          clname = 'data_tem' 
    460          CALL flinopen(TRIM(clname), mig(1), nlci , mjg(1),  nlcj   & 
    461             &    , .false.     , ipi   , ipj  , ipk   , zlon        & 
    462             &    , zlat        , zlev  , itime, istep , zdate0      & 
    463             &    , zdt         , numtdt ) 
    464  
    465          ! title, dimensions and tests 
    466          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    467             IF(lwp) THEN 
    468                WRITE(numout,*) 
    469                WRITE(numout,*) 'problem with dimensions' 
    470                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    471                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    472                WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
    473             ENDIF 
    474             STOP 'istate_gyre' 
    475          ENDIF 
    476          IF(lwp) WRITE(numout,*) itime,istep(1),zdate0,zdt,numtdt 
    477  
    478           
    479          ! Read data 
    480          zt_dta(:,:,:) = 0.e0 
    481          CALL flinget( numtdt,'votemper',jpidta,jpjdta,jpk,1,1,   & 
    482             &          1,mig(1),nlci,mjg(1),nlcj,zt_dta(1:nlci,1:nlcj,1:jpk)) 
    483  
    484          tn(:,:,:) = zt_dta(:,:,:)*tmask(:,:,:)  
    485          tb(:,:,:) = zt_dta(:,:,:)*tmask(:,:,:)  
    486  
    487          CALL flinclo( numtdt ) 
    488  
    489          IF(lwp) WRITE(numout,*) 
    490          IF(lwp) WRITE(numout,*) '              read temperature data ok' 
    491          IF(lwp) WRITE(numout,*) 
     431         CALL iom_open ( 'data_tem', inum ) 
     432         CALL iom_get ( inum, jpdom_data, 'votemper', tn )  
     433         CALL iom_close( inum ) 
     434 
     435         tn(:,:,:) = tn(:,:,:) * tmask(:,:,:)  
     436         tb(:,:,:) = tn(:,:,:) 
    492437 
    493438         ! Read salinity field 
    494439         ! ------------------- 
    495          ! open file 
    496          zdt = rdt 
    497          clname = 'data_sal' 
    498          CALL flinopen(TRIM(clname), mig(1), nlci , mjg(1),  nlcj   & 
    499             &    , .false.     , ipi   , ipj  , ipk   , zlon        & 
    500             &    , zlat        , zlev  , itime, istep , zdate0      & 
    501             &    , zdt         , numsdt ) 
    502  
    503          ! title, dimensions and tests 
    504  
    505          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    506              IF(lwp) THEN 
    507                  WRITE(numout,*) 
    508                  WRITE(numout,*) 'problem with dimensions' 
    509                  WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    510                  WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    511                  WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
    512              ENDIF 
    513              STOP 'istate_gyre' 
    514          ENDIF 
    515          IF(lwp) WRITE(numout,*) itime,istep(1),zdate0,zdt,numsdt 
    516  
    517          ! Read data 
    518          zs_dta(:,:,:) = 0.e0 
    519          CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,1,1,   & 
    520             &         1,mig(1),nlci,mjg(1),nlcj,zs_dta(1:nlci,1:nlcj,1:jpk)) 
    521  
    522          sn(:,:,:)  = zs_dta(:,:,:)*tmask(:,:,:)  
    523          sb(:,:,:)  = zs_dta(:,:,:)*tmask(:,:,:)  
    524  
    525          CALL flinclo( numsdt ) 
    526  
    527          IF(lwp) WRITE(numout,*) 
    528          IF(lwp) WRITE(numout,*) '              read salinity data ok' 
    529          IF(lwp) WRITE(numout,*) 
     440         CALL iom_open ( 'data_sal', inum ) 
     441         CALL iom_get ( inum, jpdom_data, 'vosaline', sn )  
     442         CALL iom_close( inum ) 
     443 
     444         sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:)  
     445         sb(:,:,:)  = sn(:,:,:) 
    530446 
    531447      END SELECT 

  • trunk/NEMO/OPA_SRC/lbclnk.F90

    r311 r473  
    1919 
    2020   INTERFACE lbc_lnk 
    21       MODULE PROCEDURE mpp_lnk_3d, mpp_lnk_2d 
     21      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
    2222   END INTERFACE 
    2323 
    … …  
    4949 
    5050   INTERFACE lbc_lnk 
    51       MODULE PROCEDURE lbc_lnk_3d, lbc_lnk_2d 
     51      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 
    5252   END INTERFACE 
    5353 
    … …  
    6262CONTAINS 
    6363 
    64    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn ) 
     64   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
     65      !!--------------------------------------------------------------------- 
     66      !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
     67      !! 
     68      !! ** Purpose :   set lateral boundary conditions (non mpp case) 
     69      !! 
     70      !! ** Method  : 
     71      !! 
     72      !! History : 
     73      !!        !  97-06  (G. Madec)  Original code 
     74      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
     75      !!---------------------------------------------------------------------- 
     76      !! * Arguments 
     77      CHARACTER(len=1), INTENT( in ) ::   & 
     78         cd_type1, cd_type2       ! nature of pt3d grid-points 
     79         !             !   = T ,  U , V , F or W  gridpoints 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
     81         pt3d1, pt3d2          ! 3D array on which the boundary condition is applied 
     82      REAL(wp), INTENT( in ) ::   & 
     83         psgn          ! control of the sign change 
     84         !             !   =-1 , the sign is changed if north fold boundary 
     85         !             !   = 1 , no sign change 
     86         !             !   = 0 , no sign change and > 0 required (use the inner 
     87         !             !         row/column if closed boundary) 
     88 
     89       
     90      !! * Local declarations 
     91      INTEGER  ::   ji, jk 
     92      INTEGER  ::   ijt, iju 
     93      !!---------------------------------------------------------------------- 
     94      !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     95      !! $Header$  
     96      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     97      !!---------------------------------------------------------------------- 
     98       
     99      !                                                      ! =============== 
     100      DO jk = 1, jpk                                         ! Horizontal slab 
     101         !                                                   ! =============== 
     102 
     103         !                                     ! East-West boundaries 
     104         !                                     ! ==================== 
     105         SELECT CASE ( nperio ) 
     106 
     107         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west 
     108            pt3d1( 1 ,:,jk) = pt3d1(jpim1,:,jk)          ! all points 
     109            pt3d1(jpi,:,jk) = pt3d1(  2  ,:,jk) 
     110            pt3d2( 1 ,:,jk) = pt3d2(jpim1,:,jk)           
     111            pt3d2(jpi,:,jk) = pt3d2(  2  ,:,jk) 
     112 
     113         CASE DEFAULT                          ! * closed 
     114            SELECT CASE ( cd_type1 ) 
     115            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
     116               pt3d1( 1 ,:,jk) = 0.e0 
     117               pt3d1(jpi,:,jk) = 0.e0 
     118            CASE ( 'F' )                               ! F-point 
     119               pt3d1(jpi,:,jk) = 0.e0 
     120            END SELECT 
     121            SELECT CASE ( cd_type2 ) 
     122            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
     123               pt3d2( 1 ,:,jk) = 0.e0 
     124               pt3d2(jpi,:,jk) = 0.e0 
     125            CASE ( 'F' )                               ! F-point 
     126               pt3d2(jpi,:,jk) = 0.e0 
     127            END SELECT 
     128 
     129         END SELECT 
     130 
     131         !                                     ! North-South boundaries 
     132         !                                     ! ====================== 
     133         SELECT CASE ( nperio ) 
     134 
     135         CASE ( 2 )                            ! *  south symmetric 
     136 
     137            SELECT CASE ( cd_type1 ) 
     138            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
     139               pt3d1(:, 1 ,jk) = pt3d1(:,3,jk) 
     140               pt3d1(:,jpj,jk) = 0.e0 
     141            CASE ( 'V' , 'F' )                         ! V-, F-points 
     142               pt3d1(:, 1 ,jk) = psgn * pt3d1(:,2,jk) 
     143               pt3d1(:,jpj,jk) = 0.e0 
     144            END SELECT 
     145            SELECT CASE ( cd_type2 ) 
     146            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
     147               pt3d2(:, 1 ,jk) = pt3d2(:,3,jk) 
     148               pt3d2(:,jpj,jk) = 0.e0 
     149            CASE ( 'V' , 'F' )                         ! V-, F-points 
     150               pt3d2(:, 1 ,jk) = psgn * pt3d2(:,2,jk) 
     151               pt3d2(:,jpj,jk) = 0.e0 
     152            END SELECT 
     153 
     154         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
     155 
     156            pt3d1( 1 ,jpj,jk) = 0.e0 
     157            pt3d1(jpi,jpj,jk) = 0.e0 
     158            pt3d2( 1 ,jpj,jk) = 0.e0 
     159            pt3d2(jpi,jpj,jk) = 0.e0 
     160 
     161            SELECT CASE ( cd_type1 ) 
     162            CASE ( 'T' , 'W' )                         ! T-, W-point 
     163               DO ji = 2, jpi 
     164                  ijt = jpi-ji+2 
     165                  pt3d1(ji, 1 ,jk) = 0.e0 
     166                  pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk) 
     167               END DO 
     168               DO ji = jpi/2+1, jpi 
     169                  ijt = jpi-ji+2 
     170                  pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk) 
     171               END DO 
     172            CASE ( 'U' )                               ! U-point 
     173               DO ji = 1, jpi-1 
     174                  iju = jpi-ji+1 
     175                  pt3d1(ji, 1 ,jk) = 0.e0 
     176                  pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-2,jk) 
     177               END DO 
     178               DO ji = jpi/2, jpi-1 
     179                  iju = jpi-ji+1 
     180                  pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk) 
     181               END DO 
     182            CASE ( 'V' )                               ! V-point 
     183                  DO ji = 2, jpi 
     184                     ijt = jpi-ji+2 
     185                     pt3d1(ji,  1  ,jk) = 0.e0 
     186                     pt3d1(ji,jpj-1,jk) = psgn * pt3d1(ijt,jpj-2,jk) 
     187                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(ijt,jpj-3,jk) 
     188                  END DO 
     189            CASE ( 'F' )                               ! F-point 
     190                  DO ji = 1, jpi-1 
     191                     iju = jpi-ji+1 
     192                     pt3d1(ji,jpj-1,jk) = psgn * pt3d1(iju,jpj-2,jk) 
     193                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(iju,jpj-3,jk) 
     194                  END DO 
     195            END SELECT 
     196            SELECT CASE ( cd_type2 ) 
     197            CASE ( 'T' , 'W' )                         ! T-, W-point 
     198               DO ji = 2, jpi 
     199                  ijt = jpi-ji+2 
     200                  pt3d2(ji, 1 ,jk) = 0.e0 
     201                  pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk) 
     202               END DO 
     203               DO ji = jpi/2+1, jpi 
     204                  ijt = jpi-ji+2 
     205                  pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk) 
     206               END DO 
     207            CASE ( 'U' )                               ! U-point 
     208               DO ji = 1, jpi-1 
     209                  iju = jpi-ji+1 
     210                  pt3d2(ji, 1 ,jk) = 0.e0 
     211                  pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-2,jk) 
     212               END DO 
     213               DO ji = jpi/2, jpi-1 
     214                  iju = jpi-ji+1 
     215                  pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk) 
     216               END DO 
     217            CASE ( 'V' )                               ! V-point 
     218                  DO ji = 2, jpi 
     219                     ijt = jpi-ji+2 
     220                     pt3d2(ji,  1  ,jk) = 0.e0 
     221                     pt3d2(ji,jpj-1,jk) = psgn * pt3d2(ijt,jpj-2,jk) 
     222                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(ijt,jpj-3,jk) 
     223                  END DO 
     224            CASE ( 'F' )                               ! F-point 
     225                  DO ji = 1, jpi-1 
     226                     iju = jpi-ji+1 
     227                     pt3d2(ji,jpj-1,jk) = psgn * pt3d2(iju,jpj-2,jk) 
     228                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(iju,jpj-3,jk) 
     229                  END DO 
     230            END SELECT 
     231 
     232         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
     233 
     234            pt3d1( 1 ,jpj,jk) = 0.e0 
     235            pt3d1(jpi,jpj,jk) = 0.e0 
     236            pt3d2( 1 ,jpj,jk) = 0.e0 
     237            pt3d2(jpi,jpj,jk) = 0.e0 
     238 
     239            SELECT CASE ( cd_type1 ) 
     240            CASE ( 'T' , 'W' )                         ! T-, W-point 
     241               DO ji = 1, jpi 
     242                  ijt = jpi-ji+1 
     243                  pt3d1(ji, 1 ,jk) = 0.e0 
     244                  pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-1,jk) 
     245               END DO 
     246            CASE ( 'U' )                               ! U-point 
     247                  DO ji = 1, jpi-1 
     248                     iju = jpi-ji 
     249                     pt3d1(ji, 1 ,jk) = 0.e0 
     250                     pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-1,jk) 
     251                  END DO 
     252            CASE ( 'V' )                               ! V-point 
     253                  DO ji = 1, jpi 
     254                     ijt = jpi-ji+1 
     255                     pt3d1(ji, 1 ,jk) = 0.e0 
     256                     pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk) 
     257                  END DO 
     258                  DO ji = jpi/2+1, jpi 
     259                     ijt = jpi-ji+1 
     260                     pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk) 
     261                  END DO 
     262            CASE ( 'F' )                               ! F-point 
     263                  DO ji = 1, jpi-1 
     264                     iju = jpi-ji 
     265                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(iju,jpj-2,jk) 
     266                  END DO 
     267                  DO ji = jpi/2+1, jpi-1 
     268                     iju = jpi-ji 
     269                     pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk) 
     270                  END DO 
     271            END SELECT 
     272            SELECT CASE ( cd_type2 ) 
     273            CASE ( 'T' , 'W' )                         ! T-, W-point 
     274               DO ji = 1, jpi 
     275                  ijt = jpi-ji+1 
     276                  pt3d2(ji, 1 ,jk) = 0.e0 
     277                  pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-1,jk) 
     278               END DO 
     279            CASE ( 'U' )                               ! U-point 
     280                  DO ji = 1, jpi-1 
     281                     iju = jpi-ji 
     282                     pt3d2(ji, 1 ,jk) = 0.e0 
     283                     pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-1,jk) 
     284                  END DO 
     285            CASE ( 'V' )                               ! V-point 
     286                  DO ji = 1, jpi 
     287                     ijt = jpi-ji+1 
     288                     pt3d2(ji, 1 ,jk) = 0.e0 
     289                     pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk) 
     290                  END DO 
     291                  DO ji = jpi/2+1, jpi 
     292                     ijt = jpi-ji+1 
     293                     pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk) 
     294                  END DO 
     295            CASE ( 'F' )                               ! F-point 
     296                  DO ji = 1, jpi-1 
     297                     iju = jpi-ji 
     298                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(iju,jpj-2,jk) 
     299                  END DO 
     300                  DO ji = jpi/2+1, jpi-1 
     301                     iju = jpi-ji 
     302                     pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk) 
     303                  END DO 
     304            END SELECT 
     305 
     306         CASE DEFAULT                          ! *  closed 
     307 
     308            SELECT CASE ( cd_type1 ) 
     309            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
     310               pt3d1(:, 1 ,jk) = 0.e0 
     311               pt3d1(:,jpj,jk) = 0.e0 
     312            CASE ( 'F' )                               ! F-point 
     313               pt3d1(:,jpj,jk) = 0.e0 
     314            END SELECT 
     315            SELECT CASE ( cd_type2 ) 
     316            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
     317               pt3d2(:, 1 ,jk) = 0.e0 
     318               pt3d2(:,jpj,jk) = 0.e0 
     319            CASE ( 'F' )                               ! F-point 
     320               pt3d2(:,jpj,jk) = 0.e0 
     321            END SELECT 
     322 
     323         END SELECT 
     324         !                                                   ! =============== 
     325      END DO                                                 !   End of slab 
     326      !                                                      ! =============== 
     327 
     328   END SUBROUTINE lbc_lnk_3d_gather 
     329 
     330 
     331   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp ) 
    65332      !!--------------------------------------------------------------------- 
    66333      !!                  ***  ROUTINE lbc_lnk_3d  *** 
    … …  
    86353         !             !   = 0 , no sign change and > 0 required (use the inner 
    87354         !             !         row/column if closed boundary) 
     355      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
     356         cd_mpp        ! fill the overlap area only (here do nothing) 
    88357 
    89358      !! * Local declarations 
    … …  
    95364      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    96365      !!---------------------------------------------------------------------- 
     366 
     367      IF (PRESENT(cd_mpp)) THEN 
     368         ! only fill the overlap area and extra allows  
     369         ! this is in mpp case. In this module, just do nothing 
     370      ELSE 
    97371       
    98372      !                                                      ! =============== 
    … …  
    228502      END DO                                                 !   End of slab 
    229503      !                                                      ! =============== 
     504   ENDIF 
    230505   END SUBROUTINE lbc_lnk_3d 
    231506 
    232507 
    233    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn ) 
     508   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp ) 
    234509      !!--------------------------------------------------------------------- 
    235510      !!                 ***  ROUTINE lbc_lnk_2d  *** 
    … …  
    255530      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    256531         pt2d          ! 2D array on which the boundary condition is applied 
     532      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
     533         cd_mpp        ! fill the overlap area only (here do nothing) 
    257534 
    258535      !! * Local declarations 
    … …  
    262539      !!  OPA 8.5, LODYC-IPSL (2002) 
    263540      !!---------------------------------------------------------------------- 
    264        
     541 
     542      IF (PRESENT(cd_mpp)) THEN 
     543         ! only fill the overlap area and extra allows  
     544         ! this is in mpp case. In this module, just do nothing 
     545      ELSE       
    265546       
    266547      !                                        ! East-West boundaries 
    … …  
    424705      END SELECT 
    425706 
     707      ENDIF 
     708       
    426709   END SUBROUTINE lbc_lnk_2d 
    427710 

  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r415 r473  
    1414   !!   mpp_lnk     : generic interface (defined in lbclnk) for : 
    1515   !!                 mpp_lnk_2d, mpp_lnk_3d 
     16   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays 
    1617   !!   mpp_lnk_e   : interface defined in lbclnk 
    1718   !!   mpplnks 
    … …  
    2829   !!   mpp_sum    : generic interface for : 
    2930   !!                mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real 
     31   !!   mpp_minloc 
     32   !!   mpp_maxloc 
    3033   !!   mppsync 
    3134   !!   mppstop 
    … …  
    4851   !!--------------------------------------------------------------------- 
    4952   !! * Modules used 
    50    USE dom_oce         ! ocean space and time domain  
    51    USE in_out_manager  ! I/O manager 
     53   USE dom_oce                    ! ocean space and time domain  
     54   USE in_out_manager             ! I/O manager 
    5255 
    5356   IMPLICIT NONE 
    … …  
    5558   PRIVATE 
    5659   PUBLIC  mynode, mpparent, mpp_isl, mpp_min, mpp_max, mpp_sum,  mpp_lbc_north 
    57    PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_2d_e, mpplnks 
     60   PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_3d_gather, mpp_lnk_2d_e, mpplnks 
    5861   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync 
    5962 
    … …  
    8992   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.       !: mpp flag 
    9093 
    91  
    92    !! * Module variables 
    9394   !! The processor number is a required power of two : 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024,... 
    9495   INTEGER, PARAMETER ::   & 
    … …  
    241242#endif 
    242243 
     244   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   & 
     245       t4ns, t4sn  ! 3d message passing arrays north-south & south-north 
     246   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   & 
     247       t4ew, t4we  ! 3d message passing arrays east-west & west-east 
     248   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   & 
     249       t4p1, t4p2  ! 3d message passing arrays north fold 
    243250   REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   & 
    244251       t3ns, t3sn  ! 3d message passing arrays north-south & south-north 
    … …  
    305312            CALL mpi_init( ierr ) 
    306313         CASE DEFAULT 
    307             WRITE(numout,cform_err) 
    308             WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send 
    309             nstop = nstop + 1 
     314            WRITE(ctmp1,*) '           bad value for c_mpi_send = ', c_mpi_send 
     315            CALL ctl_stop( ctmp1 ) 
    310316         END SELECT 
    311317 
    … …  
    351357            npvm_me = 0 
    352358            IF( ndim_mpp > nprocmax ) THEN 
    353                WRITE(numout,*) 'npvm_mytid=', npvm_mytid, ' too great' 
    354                STOP  ' mynode ' 
     359               WRITE(ctmp1,*) 'npvm_mytid=', npvm_mytid, ' too great' 
     360               CALL ctl_stop( ctmp1 ) 
     361 
    355362            ELSE 
    356363               npvm_nproc = ndim_mpp 
    … …  
    470477         !          --- END receive dimension --- 
    471478         IF( ndim_mpp > nprocmax ) THEN 
    472             WRITE(numout,*) 'mytid=',nt3d_mytid,' too great' 
    473             STOP  ' mpparent ' 
     479            WRITE(ctmp1,*) 'mytid=',nt3d_mytid,' too great' 
     480            CALL ctl_stop( ctmp1 ) 
    474481         ELSE 
    475482            nt3d_nproc =  ndim_mpp 
    … …  
    531538#endif 
    532539 
    533    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn ) 
     540   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp ) 
    534541      !!---------------------------------------------------------------------- 
    535542      !!                  ***  routine mpp_lnk_3d  *** 
    … …  
    564571      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
    565572         ptab          ! 3D array on which the boundary condition is applied 
     573      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
     574         cd_mpp        ! fill the overlap area only  
    566575 
    567576      !! * Local variables 
    … …  
    574583      ! 1. standard boundary treatment 
    575584      ! ------------------------------ 
    576       !                                        ! East-West boundaries 
    577       !                                        ! ==================== 
    578       IF( nbondi == 2 .AND.   &      ! Cyclic east-west 
    579          &   (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    580          ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    581          ptab(jpi,:,:) = ptab(  2  ,:,:) 
    582  
    583       ELSE                           ! closed 
     585 
     586      IF( PRESENT( cd_mpp ) ) THEN 
     587         ! only fill extra allows with 1. 
     588         ptab(     1:nlci, nlcj+1:jpj, :) = 1.e0 
     589         ptab(nlci+1:jpi ,       :   , :) = 1.e0 
     590      ELSE       
     591 
     592         !                                        ! East-West boundaries 
     593         !                                        ! ==================== 
     594         IF( nbondi == 2 .AND.   &      ! Cyclic east-west 
     595            &   (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     596            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     597            ptab(jpi,:,:) = ptab(  2  ,:,:) 
     598 
     599         ELSE                           ! closed 
     600            SELECT CASE ( cd_type ) 
     601            CASE ( 'T', 'U', 'V', 'W' ) 
     602               ptab(     1       :jpreci,:,:) = 0.e0 
     603               ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     604            CASE ( 'F' ) 
     605               ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     606            END SELECT  
     607         ENDIF 
     608 
     609         !                                        ! North-South boundaries 
     610         !                                        ! ====================== 
    584611         SELECT CASE ( cd_type ) 
    585612         CASE ( 'T', 'U', 'V', 'W' ) 
    586             ptab(     1       :jpreci,:,:) = 0.e0 
    587             ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     613            ptab(:,     1       :jprecj,:) = 0.e0 
     614            ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
    588615         CASE ( 'F' ) 
    589             ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
    590          END SELECT  
     616            ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     617         END SELECT 
     618      
    591619      ENDIF 
    592  
    593       !                                        ! North-South boundaries 
    594       !                                        ! ====================== 
    595       SELECT CASE ( cd_type ) 
    596       CASE ( 'T', 'U', 'V', 'W' ) 
    597          ptab(:,     1       :jprecj,:) = 0.e0 
    598          ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
    599       CASE ( 'F' ) 
    600          ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
    601       END SELECT 
    602  
    603620 
    604621      ! 2. East and west directions exchange 
    … …  
    763780      ! ----------------------- 
    764781 
     782      IF (PRESENT(cd_mpp)) THEN 
     783         ! No north fold treatment (it is assumed to be already OK) 
     784      
     785      ELSE       
     786 
    765787      ! 4.1 treatment without exchange (jpni odd) 
    766788      !     T-point pivot   
    … …  
    874896      END SELECT ! jpni  
    875897 
     898      ENDIF 
     899       
    876900 
    877901      ! 5. East and west directions exchange 
    … …  
    964988 
    965989 
    966    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn ) 
     990   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp ) 
    967991      !!---------------------------------------------------------------------- 
    968992      !!                  ***  routine mpp_lnk_2d  *** 
    … …  
    9961020      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    9971021         pt2d          ! 2D array on which the boundary condition is applied 
     1022      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
     1023         cd_mpp        ! fill the overlap area only  
    9981024 
    9991025      !! * Local variables 
    … …  
    10081034      ! 1. standard boundary treatment 
    10091035      ! ------------------------------ 
    1010  
    1011       !                                        ! East-West boundaries 
    1012       !                                        ! ==================== 
    1013       IF( nbondi == 2 .AND.   &      ! Cyclic east-west 
    1014          &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1015          pt2d( 1 ,:) = pt2d(jpim1,:) 
    1016          pt2d(jpi,:) = pt2d(  2  ,:) 
    1017  
    1018       ELSE                           ! ... closed 
     1036      IF (PRESENT(cd_mpp)) THEN 
     1037         ! only fill extra allows with 1. 
     1038         pt2d(     1:nlci, nlcj+1:jpj) = 1.e0 
     1039         pt2d(nlci+1:jpi ,       :   ) = 1.e0 
     1040      
     1041      ELSE       
     1042 
     1043         !                                        ! East-West boundaries 
     1044         !                                        ! ==================== 
     1045         IF( nbondi == 2 .AND.   &      ! Cyclic east-west 
     1046            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     1047            pt2d( 1 ,:) = pt2d(jpim1,:) 
     1048            pt2d(jpi,:) = pt2d(  2  ,:) 
     1049 
     1050         ELSE                           ! ... closed 
     1051            SELECT CASE ( cd_type ) 
     1052            CASE ( 'T', 'U', 'V', 'W' , 'I' ) 
     1053               pt2d(     1       :jpreci,:) = 0.e0 
     1054               pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0 
     1055            CASE ( 'F' ) 
     1056               pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0 
     1057            END SELECT 
     1058         ENDIF 
     1059 
     1060         !                                        ! North-South boundaries 
     1061         !                                        ! ====================== 
    10191062         SELECT CASE ( cd_type ) 
    10201063         CASE ( 'T', 'U', 'V', 'W' , 'I' ) 
    1021             pt2d(     1       :jpreci,:) = 0.e0 
    1022             pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0 
     1064            pt2d(:,     1       :jprecj) = 0.e0 
     1065            pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0 
    10231066         CASE ( 'F' ) 
    1024             pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0 
     1067            pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0 
    10251068         END SELECT 
     1069 
    10261070      ENDIF 
    1027  
    1028       !                                        ! North-South boundaries 
    1029       !                                        ! ====================== 
    1030       SELECT CASE ( cd_type ) 
    1031       CASE ( 'T', 'U', 'V', 'W' , 'I' ) 
    1032          pt2d(:,     1       :jprecj) = 0.e0 
    1033          pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0 
    1034       CASE ( 'F' ) 
    1035          pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0 
    1036       END SELECT 
    10371071 
    10381072 
    … …  
    11971231      ! ----------------------- 
    11981232   
     1233      IF (PRESENT(cd_mpp)) THEN 
     1234         ! No north fold treatment (it is assumed to be already OK) 
     1235      
     1236      ELSE       
     1237 
    11991238      ! 4.1 treatment without exchange (jpni odd) 
    12001239       
    … …  
    13061345      END SELECT   ! jpni 
    13071346 
     1347      ENDIF 
    13081348 
    13091349      ! 5. East and west directions 
    … …  
    13941434   
    13951435   END SUBROUTINE mpp_lnk_2d 
     1436 
     1437 
     1438   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn ) 
     1439      !!---------------------------------------------------------------------- 
     1440      !!                  ***  routine mpp_lnk_3d_gather  *** 
     1441      !! 
     1442      !! ** Purpose :   Message passing manadgement for two 3D arrays 
     1443      !! 
     1444      !! ** Method  :   Use mppsend and mpprecv function for passing mask  
     1445      !!      between processors following neighboring subdomains. 
     1446      !!            domain parameters 
     1447      !!                    nlci   : first dimension of the local subdomain 
     1448      !!                    nlcj   : second dimension of the local subdomain 
     1449      !!                    nbondi : mark for "east-west local boundary" 
     1450      !!                    nbondj : mark for "north-south local boundary" 
     1451      !!                    noea   : number for local neighboring processors  
     1452      !!                    nowe   : number for local neighboring processors 
     1453      !!                    noso   : number for local neighboring processors 
     1454      !!                    nono   : number for local neighboring processors 
     1455      !! 
     1456      !! ** Action  :   ptab1 and ptab2  with update value at its periphery 
     1457      !! 
     1458      !!---------------------------------------------------------------------- 
     1459      !! * Arguments 
     1460      CHARACTER(len=1) , INTENT( in ) ::   & 
     1461         cd_type1, cd_type2       ! define the nature of ptab array grid-points 
     1462         !                        ! = T , U , V , F , W points 
     1463         !                        ! = S : T-point, north fold treatment ??? 
     1464         !                        ! = G : F-point, north fold treatment ??? 
     1465      REAL(wp), INTENT( in ) ::   & 
     1466         psgn          ! control of the sign change 
     1467         !             !   = -1. , the sign is changed if north fold boundary 
     1468         !             !   =  1. , the sign is kept  if north fold boundary 
     1469      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   & 
     1470         ptab1, ptab2             ! 3D array on which the boundary condition is applied 
     1471 
     1472      !! * Local variables 
     1473      INTEGER ::   ji, jk, jl   ! dummy loop indices 
     1474      INTEGER ::   imigr, iihom, ijhom, iloc, ijt, iju   ! temporary integers 
     1475      INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend 
     1476      INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend 
     1477      !!---------------------------------------------------------------------- 
     1478 
     1479      ! 1. standard boundary treatment 
     1480      ! ------------------------------ 
     1481      !                                        ! East-West boundaries 
     1482      !                                        ! ==================== 
     1483      IF( nbondi == 2 .AND.   &      ! Cyclic east-west 
     1484         &   (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     1485         ptab1( 1 ,:,:) = ptab1(jpim1,:,:) 
     1486         ptab1(jpi,:,:) = ptab1(  2  ,:,:) 
     1487         ptab2( 1 ,:,:) = ptab2(jpim1,:,:) 
     1488         ptab2(jpi,:,:) = ptab2(  2  ,:,:) 
     1489 
     1490      ELSE                           ! closed 
     1491         SELECT CASE ( cd_type1 ) 
     1492         CASE ( 'T', 'U', 'V', 'W' ) 
     1493            ptab1(     1       :jpreci,:,:) = 0.e0 
     1494            ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     1495         CASE ( 'F' ) 
     1496            ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     1497         END SELECT  
     1498         SELECT CASE ( cd_type2 ) 
     1499         CASE ( 'T', 'U', 'V', 'W' ) 
     1500            ptab2(     1       :jpreci,:,:) = 0.e0 
     1501            ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     1502         CASE ( 'F' ) 
     1503            ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     1504         END SELECT  
     1505      ENDIF 
     1506 
     1507      !                                        ! North-South boundaries 
     1508      !                                        ! ====================== 
     1509      SELECT CASE ( cd_type1 ) 
     1510      CASE ( 'T', 'U', 'V', 'W' ) 
     1511         ptab1(:,     1       :jprecj,:) = 0.e0 
     1512         ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     1513      CASE ( 'F' ) 
     1514         ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     1515      END SELECT 
     1516 
     1517      SELECT CASE ( cd_type2 ) 
     1518      CASE ( 'T', 'U', 'V', 'W' ) 
     1519         ptab2(:,     1       :jprecj,:) = 0.e0 
     1520         ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     1521      CASE ( 'F' ) 
     1522         ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     1523      END SELECT 
     1524 
     1525 
     1526      ! 2. East and west directions exchange 
     1527      ! ------------------------------------ 
     1528 
     1529      ! 2.1 Read Dirichlet lateral conditions 
     1530 
     1531      SELECT CASE ( nbondi ) 
     1532      CASE ( -1, 0, 1 )    ! all exept 2  
     1533         iihom = nlci-nreci 
     1534         DO jl = 1, jpreci 
     1535            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 
     1536            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 
     1537            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 
     1538            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 
     1539         END DO 
     1540      END SELECT 
     1541 
     1542      ! 2.2 Migrations 
     1543 
     1544#if defined key_mpp_shmem 
     1545      !! * SHMEM version 
     1546 
     1547      imigr = jpreci * jpj * jpk *2 
     1548 
     1549      SELECT CASE ( nbondi ) 
     1550      CASE ( -1 ) 
     1551         CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea ) 
     1552      CASE ( 0 ) 
     1553         CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe ) 
     1554         CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea ) 
     1555      CASE ( 1 ) 
     1556         CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe ) 
     1557      END SELECT 
     1558 
     1559      CALL barrier() 
     1560      CALL shmem_udcflush() 
     1561 
     1562#elif defined key_mpp_mpi 
     1563      !! * Local variables   (MPI version) 
     1564 
     1565      imigr = jpreci * jpj * jpk *2 
     1566 
     1567      SELECT CASE ( nbondi )  
     1568      CASE ( -1 ) 
     1569         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 
     1570         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr ) 
     1571         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1572      CASE ( 0 ) 
     1573         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
     1574         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 ) 
     1575         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr ) 
     1576         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr ) 
     1577         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1578         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     1579      CASE ( 1 ) 
     1580         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
     1581         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr ) 
     1582         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1583      END SELECT 
     1584#endif 
     1585 
     1586      ! 2.3 Write Dirichlet lateral conditions 
     1587 
     1588      iihom = nlci-jpreci 
     1589 
     1590      SELECT CASE ( nbondi ) 
     1591      CASE ( -1 ) 
     1592         DO jl = 1, jpreci 
     1593            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2) 
     1594            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2) 
     1595         END DO 
     1596      CASE ( 0 )  
     1597         DO jl = 1, jpreci 
     1598            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2) 
     1599            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2) 
     1600            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2) 
     1601            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2) 
     1602         END DO 
     1603      CASE ( 1 ) 
     1604         DO jl = 1, jpreci 
     1605            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2) 
     1606            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2) 
     1607         END DO 
     1608      END SELECT 
     1609 
     1610 
     1611      ! 3. North and south directions 
     1612      ! ----------------------------- 
     1613 
     1614      ! 3.1 Read Dirichlet lateral conditions 
     1615 
     1616      IF( nbondj /= 2 ) THEN 
     1617         ijhom = nlcj-nrecj 
     1618         DO jl = 1, jprecj 
     1619            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:) 
     1620            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:) 
     1621            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:) 
     1622            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:) 
     1623         END DO 
     1624      ENDIF 
     1625 
     1626      ! 3.2 Migrations 
     1627 
     1628#if defined key_mpp_shmem 
     1629      !! * SHMEM version 
     1630 
     1631      imigr = jprecj * jpi * jpk * 2 
     1632 
     1633      SELECT CASE ( nbondj ) 
     1634      CASE ( -1 ) 
     1635         CALL shmem_put( t4sn(1,1,1,1,2), t4sn(1,1,1,1,1), imigr, nono ) 
     1636      CASE ( 0 ) 
     1637         CALL shmem_put( t4ns(1,1,1,1,2), t4ns(1,1,1,1,1), imigr, noso ) 
     1638         CALL shmem_put( t4sn(1,1,1,1,2), t4sn(1,1,1,1,1), imigr, nono ) 
     1639      CASE ( 1 ) 
     1640         CALL shmem_put( t4ns(1,1,1,1,2), t4ns(1,1,1,1;,1), imigr, noso ) 
     1641      END SELECT 
     1642 
     1643      CALL barrier() 
     1644      CALL shmem_udcflush() 
     1645 
     1646#elif defined key_mpp_mpi 
     1647      !! * Local variables   (MPI version) 
     1648   
     1649      imigr=jprecj * jpi * jpk * 2 
     1650 
     1651      SELECT CASE ( nbondj )      
     1652      CASE ( -1 ) 
     1653         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 
     1654         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr ) 
     1655         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1656      CASE ( 0 ) 
     1657         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
     1658         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 
     1659         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr ) 
     1660         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr ) 
     1661         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1662         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
     1663      CASE ( 1 )  
     1664         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
     1665         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr ) 
     1666         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
     1667      END SELECT 
     1668 
     1669#endif 
     1670 
     1671      ! 3.3 Write Dirichlet lateral conditions 
     1672 
     1673      ijhom = nlcj-jprecj 
     1674 
     1675      SELECT CASE ( nbondj ) 
     1676      CASE ( -1 ) 
     1677         DO jl = 1, jprecj 
     1678            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2) 
     1679            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2) 
     1680         END DO 
     1681      CASE ( 0 )  
     1682         DO jl = 1, jprecj 
     1683            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2) 
     1684            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2) 
     1685            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2) 
     1686            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2) 
     1687         END DO 
     1688      CASE ( 1 ) 
     1689         DO jl = 1, jprecj 
     1690            ptab1(:,jl,:) = t4sn(:,jl,:,1,2) 
     1691            ptab2(:,jl,:) = t4sn(:,jl,:,2,2) 
     1692         END DO 
     1693      END SELECT 
     1694 
     1695 
     1696      ! 4. north fold treatment 
     1697      ! ----------------------- 
     1698 
     1699      ! 4.1 treatment without exchange (jpni odd) 
     1700      !     T-point pivot   
     1701 
     1702      SELECT CASE ( jpni ) 
     1703 
     1704      CASE ( 1 )  ! only one proc along I, no mpp exchange 
     1705 
     1706      SELECT CASE ( npolj ) 
     1707   
     1708         CASE ( 3 , 4 )    ! T pivot 
     1709            iloc = jpiglo - 2 * ( nimpp - 1 ) 
     1710 
     1711            SELECT CASE ( cd_type1 ) 
     1712 
     1713            CASE ( 'T' , 'S', 'W' ) 
     1714               DO jk = 1, jpk 
     1715                  DO ji = 2, nlci 
     1716                     ijt=iloc-ji+2 
     1717                     ptab1(ji,nlcj,jk) = psgn * ptab1(ijt,nlcj-2,jk) 
     1718                  END DO 
     1719                  DO ji = nlci/2+1, nlci 
     1720                     ijt=iloc-ji+2 
     1721                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(ijt,nlcj-1,jk) 
     1722                  END DO 
     1723               END DO 
     1724           
     1725            CASE ( 'U' ) 
     1726               DO jk = 1, jpk 
     1727                  DO ji = 1, nlci-1 
     1728                     iju=iloc-ji+1 
     1729                     ptab1(ji,nlcj,jk) = psgn * ptab1(iju,nlcj-2,jk) 
     1730                  END DO 
     1731                  DO ji = nlci/2, nlci-1 
     1732                     iju=iloc-ji+1 
     1733                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(iju,nlcj-1,jk) 
     1734                  END DO 
     1735               END DO 
     1736 
     1737            CASE ( 'V' ) 
     1738               DO jk = 1, jpk 
     1739                  DO ji = 2, nlci 
     1740                     ijt=iloc-ji+2 
     1741                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(ijt,nlcj-2,jk) 
     1742                     ptab1(ji,nlcj  ,jk) = psgn * ptab1(ijt,nlcj-3,jk) 
     1743                  END DO 
     1744               END DO 
     1745 
     1746            CASE ( 'F', 'G' ) 
     1747               DO jk = 1, jpk 
     1748                  DO ji = 1, nlci-1 
     1749                     iju=iloc-ji+1 
     1750                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(iju,nlcj-2,jk) 
     1751                     ptab1(ji,nlcj  ,jk) = psgn * ptab1(iju,nlcj-3,jk) 
     1752                  END DO 
     1753               END DO 
     1754   
     1755            END SELECT 
     1756             
     1757            SELECT CASE ( cd_type2 ) 
     1758 
     1759            CASE ( 'T' , 'S', 'W' ) 
     1760               DO jk = 1, jpk 
     1761                  DO ji = 2, nlci 
     1762                     ijt=iloc-ji+2 
     1763                     ptab2(ji,nlcj,jk) = psgn * ptab2(ijt,nlcj-2,jk) 
     1764                  END DO 
     1765                  DO ji = nlci/2+1, nlci 
     1766                     ijt=iloc-ji+2 
     1767                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(ijt,nlcj-1,jk) 
     1768                  END DO 
     1769               END DO 
     1770           
     1771            CASE ( 'U' ) 
     1772               DO jk = 1, jpk 
     1773                  DO ji = 1, nlci-1 
     1774                     iju=iloc-ji+1 
     1775                     ptab2(ji,nlcj,jk) = psgn * ptab2(iju,nlcj-2,jk) 
     1776                  END DO 
     1777                  DO ji = nlci/2, nlci-1 
     1778                     iju=iloc-ji+1 
     1779                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(iju,nlcj-1,jk) 
     1780                  END DO 
     1781               END DO 
     1782 
     1783            CASE ( 'V' ) 
     1784               DO jk = 1, jpk 
     1785                  DO ji = 2, nlci 
     1786                     ijt=iloc-ji+2 
     1787                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(ijt,nlcj-2,jk) 
     1788                     ptab2(ji,nlcj  ,jk) = psgn * ptab2(ijt,nlcj-3,jk) 
     1789                  END DO 
     1790               END DO 
     1791 
     1792            CASE ( 'F', 'G' ) 
     1793               DO jk = 1, jpk 
     1794                  DO ji = 1, nlci-1 
     1795                     iju=iloc-ji+1 
     1796                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(iju,nlcj-2,jk) 
     1797                     ptab2(ji,nlcj  ,jk) = psgn * ptab2(iju,nlcj-3,jk) 
     1798                  END DO 
     1799               END DO 
     1800   
     1801          END SELECT 
     1802        
     1803         CASE ( 5 , 6 ) ! F pivot 
     1804            iloc=jpiglo-2*(nimpp-1) 
     1805   
     1806            SELECT CASE ( cd_type1 ) 
     1807 
     1808            CASE ( 'T' , 'S', 'W' ) 
     1809               DO jk = 1, jpk 
     1810                  DO ji = 1, nlci 
     1811                     ijt=iloc-ji+1 
     1812                     ptab1(ji,nlcj,jk) = psgn * ptab1(ijt,nlcj-1,jk) 
     1813                  END DO 
     1814               END DO 
     1815 
     1816            CASE ( 'U' ) 
     1817               DO jk = 1, jpk 
     1818                  DO ji = 1, nlci-1 
     1819                     iju=iloc-ji 
     1820                     ptab1(ji,nlcj,jk) = psgn * ptab1(iju,nlcj-1,jk) 
     1821                  END DO 
     1822               END DO 
     1823 
     1824            CASE ( 'V' ) 
     1825               DO jk = 1, jpk 
     1826                  DO ji = 1, nlci 
     1827                     ijt=iloc-ji+1 
     1828                     ptab1(ji,nlcj  ,jk) = psgn * ptab1(ijt,nlcj-2,jk) 
     1829                  END DO 
     1830                  DO ji = nlci/2+1, nlci 
     1831                     ijt=iloc-ji+1 
     1832                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(ijt,nlcj-1,jk) 
     1833                  END DO 
     1834               END DO 
     1835 
     1836            CASE ( 'F', 'G' ) 
     1837               DO jk = 1, jpk 
     1838                  DO ji = 1, nlci-1 
     1839                     iju=iloc-ji 
     1840                     ptab1(ji,nlcj,jk) = psgn * ptab1(iju,nlcj-2,jk) 
     1841                  END DO 
     1842                  DO ji = nlci/2+1, nlci-1 
     1843                     iju=iloc-ji 
     1844                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(iju,nlcj-1,jk) 
     1845                  END DO 
     1846               END DO 
     1847            END SELECT  ! cd_type1 
     1848 
     1849            SELECT CASE ( cd_type2 ) 
     1850 
     1851            CASE ( 'T' , 'S', 'W' ) 
     1852               DO jk = 1, jpk 
     1853                  DO ji = 1, nlci 
     1854                     ijt=iloc-ji+1 
     1855                     ptab2(ji,nlcj,jk) = psgn * ptab2(ijt,nlcj-1,jk) 
     1856                  END DO 
     1857               END DO 
     1858 
     1859            CASE ( 'U' ) 
     1860               DO jk = 1, jpk 
     1861                  DO ji = 1, nlci-1 
     1862                     iju=iloc-ji 
     1863                     ptab2(ji,nlcj,jk) = psgn * ptab2(iju,nlcj-1,jk) 
     1864                  END DO 
     1865               END DO 
     1866 
     1867            CASE ( 'V' ) 
     1868               DO jk = 1, jpk 
     1869                  DO ji = 1, nlci 
     1870                     ijt=iloc-ji+1 
     1871                     ptab2(ji,nlcj  ,jk) = psgn * ptab2(ijt,nlcj-2,jk) 
     1872                  END DO 
     1873                  DO ji = nlci/2+1, nlci 
     1874                     ijt=iloc-ji+1 
     1875                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(ijt,nlcj-1,jk) 
     1876                  END DO 
     1877               END DO 
     1878 
     1879            CASE ( 'F', 'G' ) 
     1880               DO jk = 1, jpk 
     1881                  DO ji = 1, nlci-1 
     1882                     iju=iloc-ji 
     1883                     ptab2(ji,nlcj,jk) = psgn * ptab2(iju,nlcj-2,jk) 
     1884                  END DO 
     1885                  DO ji = nlci/2+1, nlci-1 
     1886                     iju=iloc-ji 
     1887                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(iju,nlcj-1,jk) 
     1888                  END DO 
     1889               END DO 
     1890 
     1891            END SELECT  ! cd_type2 
     1892 
     1893         END SELECT     !  npolj 
     1894   
     1895      CASE DEFAULT ! more than 1 proc along I 
     1896         IF ( npolj /= 0 ) THEN 
     1897            CALL mpp_lbc_north (ptab1, cd_type1, psgn)  ! only for northern procs. 
     1898            CALL mpp_lbc_north (ptab2, cd_type2, psgn)  ! only for northern procs. 
     1899         ENDIF 
     1900 
     1901      END SELECT ! jpni  
     1902 
     1903 
     1904      ! 5. East and west directions exchange 
     1905      ! ------------------------------------ 
     1906 
     1907      SELECT CASE ( npolj ) 
     1908 
     1909      CASE ( 3, 4, 5, 6 ) 
     1910 
     1911         ! 5.1 Read Dirichlet lateral conditions 
     1912 
     1913         SELECT CASE ( nbondi ) 
     1914 
     1915         CASE ( -1, 0, 1 ) 
     1916            iihom = nlci-nreci 
     1917            DO jl = 1, jpreci 
     1918               t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 
     1919               t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 
     1920               t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 
     1921               t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 
     1922            END DO 
     1923 
     1924         END SELECT 
     1925 
     1926         ! 5.2 Migrations 
     1927 
     1928#if defined key_mpp_shmem 
     1929         !! SHMEM version 
     1930 
     1931         imigr = jpreci * jpj * jpk * 2 
     1932 
     1933         SELECT CASE ( nbondi ) 
     1934         CASE ( -1 ) 
     1935            CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea ) 
     1936         CASE ( 0 ) 
     1937            CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe ) 
     1938            CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea ) 
     1939         CASE ( 1 ) 
     1940            CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe ) 
     1941         END SELECT 
     1942 
     1943         CALL barrier() 
     1944         CALL shmem_udcflush() 
     1945 
     1946#elif defined key_mpp_mpi 
     1947         !! MPI version 
     1948 
     1949         imigr = jpreci * jpj * jpk * 2 
     1950   
     1951         SELECT CASE ( nbondi ) 
     1952         CASE ( -1 ) 
     1953            CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 ) 
     1954            CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr ) 
     1955            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1956         CASE ( 0 ) 
     1957            CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
     1958            CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 ) 
     1959            CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr ) 
     1960            CALL mpprecv( 2, t4we(1,1,1,1,2), imigr ) 
     1961            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1962            IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     1963         CASE ( 1 ) 
     1964            CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
     1965            CALL mpprecv( 2, t4we(1,1,1,1,2), imigr ) 
     1966            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     1967         END SELECT 
     1968#endif 
     1969 
     1970         ! 5.3 Write Dirichlet lateral conditions 
     1971 
     1972         iihom = nlci-jpreci 
     1973 
     1974         SELECT CASE ( nbondi) 
     1975         CASE ( -1 ) 
     1976            DO jl = 1, jpreci 
     1977               ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2) 
     1978               ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2) 
     1979            END DO 
     1980         CASE ( 0 )  
     1981            DO jl = 1, jpreci 
     1982               ptab1(jl      ,:,:) = t4we(:,jl,:,1,2) 
     1983               ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2) 
     1984               ptab2(jl      ,:,:) = t4we(:,jl,:,2,2) 
     1985               ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2) 
     1986            END DO 
     1987         CASE ( 1 ) 
     1988            DO jl = 1, jpreci 
     1989               ptab1(jl      ,:,:) = t4we(:,jl,:,1,2) 
     1990               ptab2(jl      ,:,:) = t4we(:,jl,:,2,2) 
     1991            END DO 
     1992         END SELECT 
     1993 
     1994      END SELECT    ! npolj  
     1995 
     1996   END SUBROUTINE mpp_lnk_3d_gather 
    13961997 
    13971998 
    … …  
    23052906      INTEGER, SAVE :: ibool=0 
    23062907 
    2307       IF( kdim > jpmppsum ) THEN 
    2308          WRITE(numout,*) 'mppisl_a_int routine : kdim is too big' 
    2309          WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2310          STOP 'mppisl_a_int' 
    2311       ENDIF 
     2908      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppisl_a_int routine : kdim is too big', & 
     2909           &                               'change jpmppsum dimension in mpp.h' ) 
    23122910 
    23132911      DO ji = 1, kdim 
    … …  
    24233021      INTEGER, SAVE :: ibool=0 
    24243022   
    2425       IF( kdim > jpmppsum ) THEN 
    2426          WRITE(numout,*) 'mppmin_a_int routine : kdim is too big' 
    2427          WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2428          STOP 'min_a_int' 
    2429       ENDIF 
     3023      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmin_a_int routine : kdim is too big', & 
     3024           &                               'change jpmppsum dimension in mpp.h' ) 
    24303025   
    24313026      DO ji = 1, kdim 
    … …  
    25283123      INTEGER, SAVE :: ibool=0 
    25293124 
    2530       IF( kdim > jpmppsum ) THEN 
    2531          WRITE(numout,*) 'mppsum_a_int routine : kdim is too big' 
    2532          WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2533          STOP 'mppsum_a_int' 
    2534       ENDIF 
     3125      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppsum_a_int routine : kdim is too big', & 
     3126           &                               'change jpmppsum dimension in mpp.h' ) 
    25353127 
    25363128      DO ji = 1, kdim 
    … …  
    26323224    INTEGER, SAVE :: ibool=0 
    26333225 
    2634     IF( kdim > jpmppsum ) THEN 
    2635        WRITE(numout,*) 'mppisl_a_real routine : kdim is too big' 
    2636        WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2637        STOP 'mppisl_a_real' 
    2638     ENDIF 
     3226    IF( kdim > jpmppsum ) CALL ctl_stop( 'mppisl_a_real routine : kdim is too big', & 
     3227         &                               'change jpmppsum dimension in mpp.h' ) 
    26393228 
    26403229    DO ji = 1, kdim 
    … …  
    27693358    INTEGER, SAVE :: ibool=0 
    27703359 
    2771     IF( kdim > jpmppsum ) THEN 
    2772        WRITE(numout,*) 'mppmax_a_real routine : kdim is too big' 
    2773        WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2774        STOP 'mppmax_a_real' 
    2775     ENDIF 
     3360    IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmax_a_real routine : kdim is too big', & 
     3361         &                               'change jpmppsum dimension in mpp.h' ) 
    27763362 
    27773363    DO ji = 1, kdim 
    … …  
    28693455    INTEGER, SAVE :: ibool=0 
    28703456 
    2871     IF( kdim > jpmppsum ) THEN 
    2872        WRITE(numout,*) 'mpprmin routine : kdim is too big' 
    2873        WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2874        STOP 'mpprmin' 
    2875     ENDIF 
     3457    IF( kdim > jpmppsum ) CALL ctl_stop( 'mpprmin routine : kdim is too big', & 
     3458         &                               'change jpmppsum dimension in mpp.h' ) 
    28763459 
    28773460    DO ji = 1, kdim 
    … …  
    29703553    INTEGER, SAVE :: ibool=0 
    29713554 
    2972     IF( kdim > jpmppsum ) THEN 
    2973        WRITE(numout,*) 'mppsum_a_real routine : kdim is too big' 
    2974        WRITE(numout,*) 'change jpmppsum dimension in mpp.h' 
    2975        STOP 'mppsum_a_real' 
    2976     ENDIF 
     3555    IF( kdim > jpmppsum ) CALL ctl_stop( 'mppsum_a_real routine : kdim is too big', & 
     3556         &                               'change jpmppsum dimension in mpp.h' ) 
    29773557 
    29783558    DO ji = 1, kdim 
    … …  
    30683648    !!-------------------------------------------------------------------------- 
    30693649#ifdef key_mpp_shmem 
    3070     IF (lwp) THEN 
    3071        WRITE(numout,*) ' mpp_minloc not yet available in SHMEM' 
    3072        STOP 
    3073     ENDIF 
     3650    CALL ctl_stop( ' mpp_minloc not yet available in SHMEM' ) 
    30743651# elif key_mpp_mpi 
    30753652    !! * Arguments 
    … …  
    31213698    !!-------------------------------------------------------------------------- 
    31223699#ifdef key_mpp_shmem 
    3123     IF (lwp) THEN 
    3124        WRITE(numout,*) ' mpp_minloc not yet available in SHMEM' 
    3125        STOP 
    3126     ENDIF 
     3700    CALL ctl_stop( ' mpp_minloc not yet available in SHMEM' ) 
    31273701# elif key_mpp_mpi 
    31283702    !! * Arguments 
    … …  
    31763750    !!-------------------------------------------------------------------------- 
    31773751#ifdef key_mpp_shmem 
    3178     IF (lwp) THEN 
    3179        WRITE(numout,*) ' mpp_maxloc not yet available in SHMEM' 
    3180        STOP 
    3181     ENDIF 
     3752    CALL ctl_stop( ' mpp_maxloc not yet available in SHMEM' ) 
    31823753# elif key_mpp_mpi 
    31833754    !! * Arguments 
    … …  
    32283799    !!-------------------------------------------------------------------------- 
    32293800#ifdef key_mpp_shmem 
    3230     IF (lwp) THEN 
    3231        WRITE(numout,*) ' mpp_maxloc not yet available in SHMEM' 
    3232        STOP 
    3233     ENDIF 
     3801    CALL ctl_stop( ' mpp_maxloc not yet available in SHMEM' ) 
    32343802# elif key_mpp_mpi 
    32353803    !! * Arguments 
    … …  
    33773945       ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) ) 
    33783946    ELSE 
    3379        IF(lwp)WRITE(numout,*) 'mppobc: bad ktype' 
    3380        STOP 'mppobc' 
     3947       CALL ctl_stop( 'mppobc: bad ktype' ) 
    33813948    ENDIF 
    33823949 
    … …  
    35844151    !!---------------------------------------------------------------------- 
    35854152#ifdef key_mpp_shmem 
    3586     IF (lwp) THEN 
    3587        WRITE(numout,*) ' mpp_ini_north not available in SHMEM' 
    3588        STOP 
    3589     ENDIF 
     4153    CALL ctl_stop( ' mpp_ini_north not available in SHMEM' ) 
    35904154# elif key_mpp_mpi 
    35914155    INTEGER :: ierr 
    … …  
    44685032   END SUBROUTINE mpi_init_opa 
    44695033 
    4470  
    44715034#else 
    44725035   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/mppini_2.h90

    r467 r473  
    4040      !!---------------------------------------------------------------------- 
    4141      !! * Modules used 
    42       USE ioipsl 
    43  
     42      USE iom 
     43    
    4444      !! Local variables 
    45       CHARACTER (len=25) ::               &  ! temporary name 
    46                 clname , clvar               ! filename and cdf variable name for bathy 
    47       LOGICAL ::   llbon                      ! check the existence of bathy files 
    4845      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices 
    49       INTEGER ::   inum = 11                  ! temporary logical unit 
     46      INTEGER ::  inum                        ! temporary logical unit 
    5047      INTEGER ::   & 
    5148         ii, ij, ifreq, il1, il2,          &  ! temporary integers 
    … …  
    6663         ione  , ionw  , iose  , iosw  ,   &  !    "           " 
    6764         ibne  , ibnw  , ibse  , ibsw         !    "           " 
    68       INTEGER  ::   & 
    69          ipi, ipj, ipk,              &  ! temporary integers 
    70          itime                          !    "          " 
    71       INTEGER, DIMENSION (1) ::   istep 
    72  
    73       INTEGER, DIMENSION(jpiglo,jpjglo) ::   & 
     65      INTEGER, DIMENSION(jpi,jpj) ::   & 
    7466         imask                                ! temporary global workspace 
    75  
    76       REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    77          zlamt, zphit, zdta                   ! temporary data workspace 
    78       REAL(wp), DIMENSION(jpk) ::   &    
    79          zdept                                ! temporary workspace (NetCDF read) 
    80       REAL(wp) ::   zidom , zjdom,   &        ! temporary scalars 
    81          zdt, zdate0 
     67      REAL(wp), DIMENSION(jpi,jpj) ::   & 
     68         zdta                   ! temporary data workspace 
     69      REAL(wp) ::   zidom , zjdom          ! temporary scalars 
    8270 
    8371      !!---------------------------------------------------------------------- 
    … …  
    10391#endif 
    10492 
    105  
    106       IF( jpni*jpnj < jpnij ) THEN 
    107          IF(lwp) WRITE(numout,cform_err) 
    108          IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible' 
    109          nstop = nstop + 1 
    110       ENDIF 
    111  
     93      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 
    11294 
    11395      ! 0. initialisation 
    … …  
    11597 
    11698      ! open the file 
    117          IF ( ln_zco ) THEN  
    118             clname = 'bathy_level.nc'         ! Level bathymetry 
    119             clvar = 'Bathy_level' 
    120          ELSE 
    121             clname = 'bathy_meter.nc'         ! Meter bathy in case of partial steps 
    122             clvar = 'Bathymetry' 
    123          ENDIF 
    124 #if defined key_agrif 
    125       if ( .NOT. Agrif_Root() ) then 
    126          clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    127       endif 
    128 #endif          
    129  
    130          INQUIRE( FILE=clname, EXIST=llbon ) 
    131       IF( llbon ) THEN 
    132             IF(lwp) WRITE(numout,*) 
    133             IF(lwp) WRITE(numout,*) '         read bathymetry in ', clname 
    134             IF(lwp) WRITE(numout,*) 
    135             itime = 1 
    136             ipi = jpidta 
    137             ipj = jpjdta 
    138             ipk = 1 
    139             zdt = rdt 
    140  
    141             CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   & 
    142                            ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 
    143             CALL flinget( inum, clvar, jpidta, jpjdta, 1,   & 
    144                           itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 
    145             CALL flinclo( inum ) 
     99      IF ( ln_zco ) THEN  
     100         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry 
     101         CALL iom_get ( inum, jpdom_data, 'Bathy_level', zdta ) 
    146102      ELSE 
    147          IF(lwp) WRITE(numout,cform_err) 
    148          IF(lwp) WRITE(numout,*)'    mppini_2 : unable to read the file ', clname 
    149          nstop = nstop + 1 
    150       ENDIF 
     103         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
     104         CALL iom_get ( inum, jpdom_data, 'Bathymetry' , zdta ) 
     105      ENDIF 
     106      CALL iom_close (inum) 
    151107 
    152108      ! land/sea mask over the global/zoom domain 
    153109 
    154       imask(:,:) = 1 
    155       WHERE ( zdta(jpizoom:(jpizoom+jpiglo-1),jpjzoom:(jpjglo+jpjzoom-1)) <= 0. ) imask = 0 
     110      imask(:,:)=1 
     111      WHERE ( zdta(:,:) <= 0. ) imask = 0 
    156112 
    157113      !  1. Dimension arrays for subdomains 
    … …  
    328284         DO jj = 1+jprecj, ilj-jprecj 
    329285            DO  ji = 1+jpreci, ili-jpreci 
    330                IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 
     286               IF( imask(ji, jj) == 1) isurf = isurf+1 
    331287            END DO 
    332288         END DO 
    … …  
    341297      ! Control 
    342298      IF(icont+1 /= jpnij) THEN 
    343          IF(lwp) THEN  
    344             WRITE(numout,*) ' Eliminate land processors algorithm' 
    345             WRITE(numout,*) 
    346             WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj 
    347             WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj'  
    348             WRITE(numout,*) 
    349             WRITE(numout,*) ' E R R O R ' 
    350             WRITE(numout,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
    351             WRITE(numout,*) ' we stop' 
    352          ENDIF 
    353          STOP 'mpp_init2' 
    354       ENDIF 
    355  
     299         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj 
     300         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'  
     301         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
     302         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
     303      ENDIF 
    356304 
    357305      ! 4. Subdomain print 
    … …  
    518466      ! Save processor layout in ascii file 
    519467      IF (lwp) THEN 
    520         OPEN(inum,FILE='layout.dat') 
    521         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
    522         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
     468         inum = 11 ! how do we know that 11 is ok??? 
     469         OPEN(inum,FILE='layout.dat') 
     470         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
     471         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
    523472 
    524473        DO  jproc = 1, jpnij 
    … …  
    565514      ENDIF 
    566515 
    567       IF( nperio == 1 .AND.jpni /= 1 ) THEN 
    568          IF(lwp) WRITE(numout,cform_err) 
    569          IF(lwp) WRITE(numout,*) ' mpp_init2:  error on cyclicity' 
    570          nstop = nstop + 1 
    571       ENDIF 
     516      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' ) 
    572517 
    573518      ! Prepare mpp north fold 

  • trunk/NEMO/OPA_SRC/opa.F90

    r467 r473  
    200200      lwp   = narea == 1 
    201201 
     202      IF( lk_mpp )   THEN 
     203         CLOSE( numout )       ! standard model output file 
     204         WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 
     205         IF ( numout /= 0 .AND. numout /= 6 ) THEN  
     206            CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
     207                 &         'SEQUENTIAL', 1, numout, .FALSE., 1 ) 
     208         ENDIF 
     209         ! 
     210         WRITE(numout,*) 
     211         WRITE(numout,*) '                 L O D Y C - I P S L' 
     212         WRITE(numout,*) '                     O P A model' 
     213         WRITE(numout,*) '            Ocean General Circulation Model' 
     214         WRITE(numout,*) '               version OPA 9.0  (2005) ' 
     215         WRITE(numout,*) '                   MPI Ocean output ' 
     216         WRITE(numout,*) 
     217         WRITE(numout,*) 
     218      ENDIF 
     219 
    202220      !                                     ! ============================== ! 
    203221      !                                     !  Model general initialization  ! 
    … …  
    366384      CLOSE( numout )       ! standard model output file 
    367385      CLOSE( numstp )       ! time-step file 
    368       CLOSE( numwrs )       ! ocean restart file 
    369  
    370       IF( lk_dtatem )   CLOSE( numtdt ) 
    371       IF( lk_dtasal )   CLOSE( numsdt ) 
    372       IF( lk_dtasst )   CLOSE( numsst ) 
    373386 
    374387      IF(lwp) CLOSE( numsol ) 
    375  
    376       IF( lk_cpl ) THEN 
    377          CLOSE( numlhf ) 
    378          CLOSE( numlts ) 
    379       ENDIF 
    380  
    381       CLOSE( numwri ) 
    382388 
    383389   END SUBROUTINE opa_closefile 

  • trunk/NEMO/OPA_SRC/prtctl.F90

    r426 r473  
    135135      DO jn = sind, eind 
    136136 
    137          numid = 80 + jn 
     137         numid = 90 
    138138 
    139139         ! Set indices for the SUM control 
    … …  
    244244      DO jn = sind, eind 
    245245 
    246          numid = 80 + jn 
     246         numid = 90  
    247247 
    248248         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    … …  
    330330 
    331331      DO jn = sind, eind 
    332          numid = 80 + jn 
     332         numid = 90  
    333333         WRITE(clfile_out,FMT=clb_name) jn-1 
    334334         OPEN ( UNIT=numid, FILE=TRIM(clfile_out),FORM='FORMATTED' ) 

  • trunk/NEMO/OPA_SRC/restart.F90

    r467 r473  
    8484      CHARACTER (len=50) ::   clname, cln 
    8585      INTEGER ::   ic, jc, itime 
     86      INTEGER ::   inumwrs 
    8687      REAL(wp) ::   zdate0 
    8788      REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk 
    … …  
    111112         IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    112113 
    113          ! Job informations 
     114         ! Job informations  
     115         zinfo(:) = 0.e0  
    114116         zinfo(1) = FLOAT( no        )   ! job number 
    115117         zinfo(2) = FLOAT( kt        )   ! time-step 
    … …  
    132134            CLOSE( knum, STATUS='delete' ) 
    133135#else             
    134             OPEN( UNIT=numwrs, FILE=crestart, STATUS='old' ) 
    135             CLOSE( numwrs, STATUS='delete' ) 
     136            OPEN( UNIT=inumwrs, FILE=crestart, STATUS='old' ) 
     137            CLOSE( inumwrs, STATUS='delete' ) 
    136138#endif 
    137139         ENDIF 
    … …  
    152154         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 ) 
    153155         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept_0, clname,   & 
    154                         itime, zdate0, rdt*nstock ,numwrs, domain_id=nidom ) 
    155  
    156          CALL restput( numwrs, 'info'   , 1  , 1  , 10 , 0, zinfo   )   ! restart informations 
     156                        itime, zdate0, rdt*nstock ,inumwrs, domain_id=nidom ) 
     157 
     158         CALL restput( inumwrs, 'info'   , 1  , 1  , 10 , 0, zinfo   )   ! restart informations 
    157159          
    158          CALL restput( numwrs, 'ub'     , jpi, jpj, jpk, 0, ub      )   ! prognostic variables 
    159          CALL restput( numwrs, 'vb'     , jpi, jpj, jpk, 0, vb      ) 
    160          CALL restput( numwrs, 'tb'     , jpi, jpj, jpk, 0, tb      ) 
    161          CALL restput( numwrs, 'sb'     , jpi, jpj, jpk, 0, sb      ) 
    162          CALL restput( numwrs, 'rotb'   , jpi, jpj, jpk, 0, rotb    ) 
    163          CALL restput( numwrs, 'hdivb'  , jpi, jpj, jpk, 0, hdivb   ) 
    164          CALL restput( numwrs, 'un'     , jpi, jpj, jpk, 0, un      ) 
    165          CALL restput( numwrs, 'vn'     , jpi, jpj, jpk, 0, vn      ) 
    166          CALL restput( numwrs, 'tn'     , jpi, jpj, jpk, 0, tn      ) 
    167          CALL restput( numwrs, 'sn'     , jpi, jpj, jpk, 0, sn      ) 
    168          CALL restput( numwrs, 'rotn'   , jpi, jpj, jpk, 0, rotn    ) 
    169          CALL restput( numwrs, 'hdivn'  , jpi, jpj, jpk, 0, hdivn   ) 
     160         CALL restput( inumwrs, 'ub'     , jpi, jpj, jpk, 0, ub      )   ! prognostic variables 
     161         CALL restput( inumwrs, 'vb'     , jpi, jpj, jpk, 0, vb      ) 
     162         CALL restput( inumwrs, 'tb'     , jpi, jpj, jpk, 0, tb      ) 
     163         CALL restput( inumwrs, 'sb'     , jpi, jpj, jpk, 0, sb      ) 
     164         CALL restput( inumwrs, 'rotb'   , jpi, jpj, jpk, 0, rotb    ) 
     165         CALL restput( inumwrs, 'hdivb'  , jpi, jpj, jpk, 0, hdivb   ) 
     166         CALL restput( inumwrs, 'un'     , jpi, jpj, jpk, 0, un      ) 
     167         CALL restput( inumwrs, 'vn'     , jpi, jpj, jpk, 0, vn      ) 
     168         CALL restput( inumwrs, 'tn'     , jpi, jpj, jpk, 0, tn      ) 
     169         CALL restput( inumwrs, 'sn'     , jpi, jpj, jpk, 0, sn      ) 
     170         CALL restput( inumwrs, 'rotn'   , jpi, jpj, jpk, 0, rotn    ) 
     171         CALL restput( inumwrs, 'hdivn'  , jpi, jpj, jpk, 0, hdivn   ) 
    170172 
    171173         ztab(:,:) = gcx(1:jpi,1:jpj) 
    172          CALL restput( numwrs, 'gcx'    , jpi, jpj, 1  , 0, ztab    )   ! Read elliptic solver arrays 
     174         CALL restput( inumwrs, 'gcx'    , jpi, jpj, 1  , 0, ztab    )   ! Read elliptic solver arrays 
    173175         ztab(:,:) = gcxb(1:jpi,1:jpj) 
    174          CALL restput( numwrs, 'gcxb'   , jpi, jpj, 1  , 0, ztab    ) 
     176         CALL restput( inumwrs, 'gcxb'   , jpi, jpj, 1  , 0, ztab    ) 
    175177# if defined key_dynspg_rl 
    176          CALL restput( numwrs, 'bsfb'   , jpi, jpj, 1  , 0, bsfb    )   ! Rigid-lid formulation (bsf) 
    177          CALL restput( numwrs, 'bsfn'   , jpi, jpj, 1  , 0, bsfn    ) 
    178          CALL restput( numwrs, 'bsfd'   , jpi, jpj, 1  , 0, bsfd    ) 
     178         CALL restput( inumwrs, 'bsfb'   , jpi, jpj, 1  , 0, bsfb    )   ! Rigid-lid formulation (bsf) 
     179         CALL restput( inumwrs, 'bsfn'   , jpi, jpj, 1  , 0, bsfn    ) 
     180         CALL restput( inumwrs, 'bsfd'   , jpi, jpj, 1  , 0, bsfd    ) 
    179181# else 
    180          CALL restput( numwrs, 'sshb'   , jpi, jpj, 1  , 0, sshb    )   ! free surface formulation (ssh) 
    181          CALL restput( numwrs, 'sshn'   , jpi, jpj, 1  , 0, sshn    ) 
     182         CALL restput( inumwrs, 'sshb'   , jpi, jpj, 1  , 0, sshb    )   ! free surface formulation (ssh) 
     183         CALL restput( inumwrs, 'sshn'   , jpi, jpj, 1  , 0, sshn    ) 
    182184#  if defined key_dynspg_ts 
    183          CALL restput( numwrs, 'sshb_b' , jpi, jpj, 1  , 0, sshb_b  )   ! free surface formulation (ssh) 
    184          CALL restput( numwrs, 'sshn_b' , jpi, jpj, 1  , 0, sshn_b  )   ! issued from barotropic loop 
    185          CALL restput( numwrs, 'un_b'   , jpi, jpj, 1  , 0, un_b    )   ! horizontal transports 
    186          CALL restput( numwrs, 'vn_b'   , jpi, jpj, 1  , 0, vn_b    )   ! issued from barotropic loop 
     185         CALL restput( inumwrs, 'sshb_b' , jpi, jpj, 1  , 0, sshb_b  )   ! free surface formulation (ssh) 
     186         CALL restput( inumwrs, 'sshn_b' , jpi, jpj, 1  , 0, sshn_b  )   ! issued from barotropic loop 
     187         CALL restput( inumwrs, 'un_b'   , jpi, jpj, 1  , 0, un_b    )   ! horizontal transports 
     188         CALL restput( inumwrs, 'vn_b'   , jpi, jpj, 1  , 0, vn_b    )   ! issued from barotropic loop 
    187189#  endif 
    188190# endif 
    189191# if defined key_zdftke   ||   defined key_esopa 
    190192         IF( lk_zdftke ) THEN 
    191             CALL restput( numwrs, 'en'     , jpi, jpj, jpk, 0, en      )   ! TKE arrays 
     193            CALL restput( inumwrs, 'en'     , jpi, jpj, jpk, 0, en      )   ! TKE arrays 
    192194         ENDIF 
    193195# endif 
    194196# if defined key_ice_lim 
    195197         zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model 
    196          CALL restput( numwrs, 'nfice'  ,   1,   1, 1  , 0, zfice   ) 
    197          CALL restput( numwrs, 'sst_io' , jpi, jpj, 1  , 0, sst_io  ) 
    198          CALL restput( numwrs, 'sss_io' , jpi, jpj, 1  , 0, sss_io  ) 
    199          CALL restput( numwrs, 'u_io'   , jpi, jpj, 1  , 0, u_io    ) 
    200          CALL restput( numwrs, 'v_io'   , jpi, jpj, 1  , 0, v_io    ) 
     198         CALL restput( inumwrs, 'nfice'  ,   1,   1, 1  , 0, zfice   ) 
     199         CALL restput( inumwrs, 'sst_io' , jpi, jpj, 1  , 0, sst_io  ) 
     200         CALL restput( inumwrs, 'sss_io' , jpi, jpj, 1  , 0, sss_io  ) 
     201         CALL restput( inumwrs, 'u_io'   , jpi, jpj, 1  , 0, u_io    ) 
     202         CALL restput( inumwrs, 'v_io'   , jpi, jpj, 1  , 0, v_io    ) 
    201203# if defined key_coupled 
    202          CALL restput( numwrs, 'alb_ice', jpi, jpj, 1  , 0, alb_ice ) 
     204         CALL restput( inumwrs, 'alb_ice', jpi, jpj, 1  , 0, alb_ice ) 
    203205# endif 
    204206# endif 
    205207# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    206208         zfblk(1) = FLOAT( nfbulk )                                 ! Bulk 
    207          CALL restput( numwrs, 'nfbulk' ,   1,   1, 1  , 0, zfblk   ) 
    208          CALL restput( numwrs, 'gsst'   , jpi, jpj, 1  , 0, gsst    ) 
    209 # endif 
    210  
    211          CALL restclo( numwrs )                                         ! close the restart file 
     209         CALL restput( inumwrs, 'nfbulk' ,   1,   1, 1  , 0, zfblk   ) 
     210         CALL restput( inumwrs, 'gsst'   , jpi, jpj, 1  , 0, gsst    ) 
     211# endif 
     212 
     213         CALL restclo( inumwrs )                                         ! close the restart file 
    212214          
    213215      ENDIF 
    … …  
    251253      !!---------------------------------------------------------------------- 
    252254      !! * Modules used 
    253       USE ioipsl 
     255      USE iom 
    254256 
    255257      !! * Local declarations 
    256       LOGICAL ::   llog 
    257       CHARACTER (len=8 ) ::   clvnames(50) 
    258       CHARACTER (len=32) ::   clname 
    259258      INTEGER  ::   & 
    260          itime, ibvar,     &  ! 
    261259         inum                 ! temporary logical unit 
    262       REAL(wp) ::   zdate0, zdt, zinfo(10) 
    263       REAL(wp) ::   zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj) 
    264       REAL(wp), DIMENSION(jpi,jpj) :: ztab  
     260      REAL(wp), DIMENSION(1, 1, 10)  ::   zinfo 
     261      REAL(wp), DIMENSION(1, 1, 1)   ::   zzz  
     262      INTEGER  ::   ios 
    265263#   if defined key_ice_lim 
    266       INTEGER  ::   ios1, ji, jj, jn 
    267       REAL(wp) ::   zfice(1) 
    268 #   endif 
    269 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    270       INTEGER  ::   ios2, jk 
    271       REAL(wp) ::   zfblk(1) 
     264      INTEGER  ::   ji, jj 
    272265#   endif 
    273266      !!---------------------------------------------------------------------- 
    274       !!  OPA 8.5, LODYC-IPSL (2002) 
    275       !!---------------------------------------------------------------------- 
    276       clname = 'restart' 
    277 #if defined key_agrif        
    278        inum = Agrif_Get_Unit() 
    279        If(.NOT. Agrif_root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    280 #endif  
    281267 
    282268      IF(lwp) WRITE(numout,*) 
    … …  
    314300      END SELECT 
    315301 
    316       itime = 0 
    317       llog  = .FALSE. 
    318       zlamt(:,:) = 0.e0 
    319       zphit(:,:) = 0.e0 
    320       zdept(:)   = 0.e0 
    321       CALL restini( clname, jpi, jpj, zlamt, zphit, jpk, zdept, 'NONE',   & 
    322          &          itime, zdate0, zdt, inum, domain_id=nidom ) 
    323  
    324       CALL ioget_vname( inum, ibvar, clvnames) 
    325       CALL restget( inum, 'info', 1, 1, 10, 0, llog, zinfo ) 
    326  
     302      CALL iom_open ( 'restart', inum ) 
     303       
     304      CALL iom_get ( inum, jpdom_unknown, 'info', zinfo ) 
     305       
    327306      IF(lwp) WRITE(numout,*) 
    328307      IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 
    329       IF(lwp) WRITE(numout,*) '   FILE name           : ', clname 
    330       IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1) ) 
    331       IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(2) ) 
    332       IF(lwp) WRITE(numout,*) '   solver type         : ', NINT( zinfo(4) ) + 1 
    333       IF(lwp) WRITE(numout,*) '   tke option          : ', NINT( zinfo(5) ) 
    334       IF(lwp) WRITE(numout,*) '   date ndastp         : ', NINT( zinfo(6) ) 
    335       IF(lwp) WRITE(numout,*) '   number of variables : ', ibvar 
    336       IF(lwp) WRITE(numout,*) '   NetCDF variables    : ', clvnames(1:ibvar) 
     308      IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1, 1, 1) ) 
     309      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(1, 1, 2) ) 
     310      IF(lwp) WRITE(numout,*) '   solver type         : ', NINT( zinfo(1, 1, 4) ) + 1 
     311      IF(lwp) WRITE(numout,*) '   tke option          : ', NINT( zinfo(1, 1, 5) ) 
     312      IF(lwp) WRITE(numout,*) '   date ndastp         : ', NINT( zinfo(1, 1, 6) ) 
    337313      IF(lwp) WRITE(numout,*) 
    338314 
    339315      ! Control of date 
    340       IF( nit000 - NINT( zinfo(2) )  /= 1 .AND. nrstdt /= 0 ) THEN 
    341          IF(lwp) WRITE(numout,cform_err) 
    342          IF(lwp) WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart' 
    343          IF(lwp) WRITE(numout,*) ' verify the restart file or rerun with nrstdt = 0 (namelist)' 
    344          nstop = nstop + 1 
    345       ENDIF 
     316      IF( nit000 - NINT( zinfo(1, 1, 2) )  /= 1 .AND. nrstdt /= 0 ) & 
     317           & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 
     318           & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
    346319 
    347320      ! re-initialisation of  adatrj0 
    … …  
    352325!                             ndate0 has been read in the namelist (standard OPA 8) 
    353326!                             here when nrstdt=2 we keep the  final date of previous run 
    354         ndastp = NINT( zinfo(6) ) 
    355         adatrj0 =  zinfo(7) 
    356       ENDIF 
    357  
    358  
    359  
    360       CALL restget( inum, 'ub'     , jpi, jpj, jpk, 0, llog, ub      )    ! Read prognostic variables 
    361       CALL restget( inum, 'vb'     , jpi, jpj, jpk, 0, llog, vb      ) 
    362       CALL restget( inum, 'tb'     , jpi, jpj, jpk, 0, llog, tb      ) 
    363       CALL restget( inum, 'sb'     , jpi, jpj, jpk, 0, llog, sb      ) 
    364       CALL restget( inum, 'rotb'   , jpi, jpj, jpk, 0, llog, rotb    ) 
    365       CALL restget( inum, 'hdivb'  , jpi, jpj, jpk, 0, llog, hdivb   ) 
    366       CALL restget( inum, 'un'     , jpi, jpj, jpk, 0, llog, un      ) 
    367       CALL restget( inum, 'vn'     , jpi, jpj, jpk, 0, llog, vn      ) 
    368       CALL restget( inum, 'tn'     , jpi, jpj, jpk, 0, llog, tn      ) 
    369       CALL restget( inum, 'sn'     , jpi, jpj, jpk, 0, llog, sn      ) 
    370       CALL restget( inum, 'rotn'   , jpi, jpj, jpk, 0, llog, rotn    ) 
    371       CALL restget( inum, 'hdivn'  , jpi, jpj, jpk, 0, llog, hdivn   ) 
    372  
    373       CALL restget( inum, 'gcxb'   , jpi, jpj, 1  , 0, llog, ztab    )   ! Read elliptic solver arrays 
    374       gcxb(1:jpi,1:jpj) = ztab(:,:)  
    375       CALL restget( inum, 'gcx'    , jpi, jpj, 1  , 0, llog, ztab    ) 
    376       gcx(1:jpi,1:jpj) = ztab(:,:)  
     327        ndastp = NINT( zinfo(1, 1, 6) ) 
     328        adatrj0 =  zinfo(1, 1, 7) 
     329      ENDIF 
     330 
     331      CALL iom_get( inum, jpdom_local, 'ub'   , ub    )   ! Read prognostic variables 
     332      CALL iom_get( inum, jpdom_local, 'vb'   , vb    ) 
     333      CALL iom_get( inum, jpdom_local, 'tb'   , tb    ) 
     334      CALL iom_get( inum, jpdom_local, 'sb'   , sb    ) 
     335      CALL iom_get( inum, jpdom_local, 'rotb' , rotb  ) 
     336      CALL iom_get( inum, jpdom_local, 'hdivb', hdivb ) 
     337      CALL iom_get( inum, jpdom_local, 'un'   , un    ) 
     338      CALL iom_get( inum, jpdom_local, 'vn'   , vn    ) 
     339      CALL iom_get( inum, jpdom_local, 'tn'   , tn    ) 
     340      CALL iom_get( inum, jpdom_local, 'sn'   , sn    ) 
     341      CALL iom_get( inum, jpdom_local, 'rotn' , rotn  ) 
     342      CALL iom_get( inum, jpdom_local, 'hdivn', hdivn ) 
     343! Caution : extrahallow  
     344! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
     345      CALL iom_get( inum, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) ) 
     346      CALL iom_get( inum, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) )     ! Read elliptic solver arrays 
    377347# if defined key_dynspg_rl 
    378       CALL restget( inum, 'bsfb'   , jpi, jpj, 1  , 0, llog, bsfb    )   ! Rigid-lid formulation (bsf) 
    379       CALL restget( inum, 'bsfn'   , jpi, jpj, 1  , 0, llog, bsfn    ) 
    380       CALL restget( inum, 'bsfd'   , jpi, jpj, 1  , 0, llog, bsfd    ) 
     348      CALL iom_get( inum, jpdom_local, 'bsfb', bsfb )     ! Rigid-lid formulation (bsf) 
     349      CALL iom_get( inum, jpdom_local, 'bsfn', bsfn ) 
     350      CALL iom_get( inum, jpdom_local, 'bsfd', bsfd ) 
    381351# else 
    382       CALL restget( inum, 'sshb'   , jpi, jpj, 1  , 0, llog, sshb    )   ! free surface formulation (ssh) 
    383       CALL restget( inum, 'sshn'   , jpi, jpj, 1  , 0, llog, sshn    ) 
     352      CALL iom_get( inum, jpdom_local, 'sshb', sshb )     ! free surface formulation (ssh) 
     353      CALL iom_get( inum, jpdom_local, 'sshn', sshn ) 
    384354#  if defined key_dynspg_ts 
    385       CALL restget( inum, 'sshb_b' , jpi, jpj, 1  , 0, llog, sshb_b  )  ! free surface formulation (ssh) 
    386       CALL restget( inum, 'sshn_b' , jpi, jpj, 1  , 0, llog, sshn_b  )  ! issued from barotropic loop 
    387       CALL restget( inum, 'un_b'   , jpi, jpj, 1  , 0, llog, un_b    )   ! horizontal transports 
    388       CALL restget( inum, 'vn_b'   , jpi, jpj, 1  , 0, llog, vn_b    )   ! issued from barotropic loop 
     355      CALL iom_get( inum, jpdom_local, 'sshb_b', sshb_b ) ! free surface formulation (ssh) 
     356      CALL iom_get( inum, jpdom_local, 'sshn_b', sshn_b ) ! issued from barotropic loop 
     357      CALL iom_get( inum, jpdom_local, 'un_b'  , un_b )   ! horizontal transports 
     358      CALL iom_get( inum, jpdom_local, 'vn_b'  , vn_b )   ! issued from barotropic loop 
    389359#  endif 
    390360# endif 
    391361# if defined key_zdftke   ||   defined key_esopa 
    392362      IF( lk_zdftke ) THEN 
    393          IF( NINT( zinfo(5) ) == 1 ) THEN                                ! Read tke arrays 
    394             CALL restget( inum, 'en',jpi,jpj, jpk,0  , llog, en ) 
     363         IF( NINT( zinfo(1, 1, 5) ) == 1 ) THEN                                ! Read tke arrays 
     364            CALL iom_get( inum, jpdom_local, 'en', en ) 
    395365            ln_rstke = .FALSE. 
    396366         ELSE 
    397             IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme' 
     367            IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file did not used  tke scheme' 
    398368            IF(lwp) WRITE(numout,*) ' =======                =======' 
    399369            nrstdt = 2 
    … …  
    404374# if defined key_ice_lim 
    405375      ! Louvain La Neuve Sea Ice Model 
    406       ios1 = 0 
    407       DO jn = 1, 30 
    408          IF( clvnames(jn) == 'nfice' )  ios1 = 1 
    409       END DO 
    410       IF( ios1 == 1 ) THEN 
    411          CALL restget( inum, 'nfice' ,   1,   1, 1 , 0, llog, zfice  ) 
    412          CALL restget( inum, 'sst_io', jpi, jpj, 1 , 0, llog, sst_io ) 
    413          CALL restget( inum, 'sss_io', jpi, jpj, 1 , 0, llog, sss_io ) 
    414          CALL restget( inum, 'u_io'  , jpi, jpj, 1 , 0, llog, u_io   ) 
    415          CALL restget( inum, 'v_io'  , jpi, jpj, 1 , 0, llog, v_io   ) 
     376      ios = iom_varid( inum, 'nfice' ) 
     377      IF( ios > 0 ) then  
     378         CALL iom_get( inum, jpdom_unknown, 'nfice' , zzz ) 
     379         zinfo(1, 1, 8) = zzz(1, 1, 1) 
     380         CALL iom_get( inum, jpdom_local, 'sst_io', sst_io ) 
     381         CALL iom_get( inum, jpdom_local, 'sss_io', sss_io ) 
     382         CALL iom_get( inum, jpdom_local, 'u_io'  , u_io ) 
     383         CALL iom_get( inum, jpdom_local, 'v_io'  , v_io ) 
    416384#if defined key_coupled 
    417          CALL restget( inum, 'alb_ice', jpi, jpj, 1 , 0, llog, alb_ice ) 
     385         CALL iom_get( inum, jpdom_local, 'alb_ice', alb_ice ) 
    418386#endif 
    419387      ENDIF 
    420       IF( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN 
     388      IF( zinfo(1, 1, 8) /= FLOAT(nfice) .OR. ios == 0 ) THEN 
    421389         IF(lwp) WRITE(numout,*) 
    422390         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization' 
    … …  
    437405# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    438406      ! Louvain La Neuve Sea Ice Model 
    439       ios2 = 0 
    440       DO jk = 1, 30 
    441          IF( clvnames(jk) == 'nfbulk' )  ios2 = 1 
    442       END DO 
    443       IF( ios2 == 1 ) THEN 
    444          CALL restget( inum, 'nfbulk',   1,   1, 1 , 0, llog, zfblk ) 
    445          CALL restget( inum, 'gsst'  , jpi, jpj, 1 , 0, llog, gsst  ) 
    446       ENDIF 
    447       IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN 
     407      ios = iom_varid( inum, 'nfbulk' ) 
     408      IF( ios > 0 ) then  
     409         CALL iom_get( inum, jpdom_unknown, 'nfbulk' , zzz ) 
     410         CALL iom_get( inum, jpdom_local, 'gsst' , gsst ) 
     411         zinfo(1, 1, 9) = zzz(1, 1, 1) 
     412      ENDIF 
     413      IF( zinfo(1, 1, 9) /= FLOAT(nfbulk) .OR. ios == 0 ) THEN 
    448414         IF(lwp) WRITE(numout,*) 
    449415         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization' 
    … …  
    454420# endif 
    455421       
    456       CALL restclo( inum ) 
     422      CALL iom_close( inum ) 
     423 
    457424  ! In case of restart with neuler = 0 then put all before fields = to now fields 
    458425    IF ( neuler == 0 ) THEN 
Note: See TracChangeset for help on using the changeset viewer.