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

Changeset 389


Ignore:
Timestamp:
2006-03-09T18:22:04+01:00 (18 years ago)
Author:
opalod
Message:

RB:nemo_v1_update_038: first integration of Agrif :

  • configuration parameters are just integer when agrif is used
  • add call to agrif routines with key_agrif
Location:
trunk/NEMO/OPA_SRC
Files:
48 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/DIA/diafwb.F90

    r359 r389  
    202202         END SELECT 
    203203         !  
    204       ENDIF 
     204       
    205205      DO jk = 1, 18  
    206206         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    … …  
    218218         ENDIF 
    219219      END DO 
     220      ENDIF 
    220221       
    221222      ! Mean flow at Cadiz 
    … …  
    242243         END SELECT 
    243244         !  
    244       ENDIF 
     245       
    245246      DO jk = 1, 23  
    246247         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    … …  
    258259         ENDIF 
    259260      END DO 
     261      ENDIF 
    260262 
    261263      ! Mean flow at Red Sea entrance 
    … …  
    282284         END SELECT 
    283285         !  
    284       ENDIF 
     286       
    285287      DO jk = 1, 15  
    286288         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    … …  
    298300         ENDIF 
    299301      END DO 
     302      ENDIF 
    300303 
    301304      ! Mean flow at Baltic Sea entrance 
    … …  
    322325         END SELECT 
    323326         !  
    324       ENDIF 
     327       
    325328      DO jk = 1, 20 
    326329         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    … …  
    338341         ENDIF 
    339342      END DO 
     343      ENDIF 
    340344 
    341345      ! Sum at each time-step 

  • trunk/NEMO/OPA_SRC/DIA/diaptr.F90

    r352 r389  
    8888      !! * local declarations 
    8989      INTEGER  ::   ji, jj, jk        ! dummy loop arguments 
     90#if ! defined key_AGRIF 
    9091      INTEGER  ::   ijpj = jpj        ! ??? 
     92#else 
     93      INTEGER  ::   ijpj             ! ??? 
     94#endif       
    9195      REAL(wp),DIMENSION(jpj) ::   & 
    9296         p_fval                       ! function value 
    9397      !!-------------------------------------------------------------------- 
     98#if defined key_AGRIF 
     99      ijpj = jpj 
     100#endif       
    94101 
    95102      p_fval(:) = 0.e0 
    … …  
    129136      !! * local declarations 
    130137      INTEGER  ::   ji,jj             ! dummy loop arguments 
     138#if ! defined key_AGRIF 
    131139      INTEGER  ::   ijpj = jpj        ! ??? 
     140#else 
     141      INTEGER  ::   ijpj             ! ??? 
     142#endif       
    132143      REAL(wp),DIMENSION(jpj) ::   & 
    133144         p_fval                       ! function value 
    134145      !!-------------------------------------------------------------------- 
     146#if defined key_AGRIF 
     147      ijpj = jpj 
     148#endif       
    135149  
    136150      p_fval(:) = 0.e0 

  • trunk/NEMO/OPA_SRC/DIA/diawri.F90

    r359 r389  
    120120      REAL(wp), DIMENSION(jpi,jpj) :: & 
    121121         zw2d                            ! temporary workspace 
     122      CHARACTER (len=80) :: clname 
    122123      !!---------------------------------------------------------------------- 
    123124       
    … …  
    172173         ! WRITE root name in date.file for use by postpro 
    173174         CALL dia_nam( clhstnam, nwrite,' ' ) 
    174          CALL ctlopn( inum, 'date.file', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
     175         clname = 'date.file' 
     176         CALL ctlopn( inum, clname,  'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
    175177         WRITE(inum,*) clhstnam 
    176178         CLOSE(inum) 

  • trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r359 r389  
    272272         &   .OR.       kindic <   0            & 
    273273         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN 
    274        OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND ') 
     274       OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND') 
    275275 
    276276       IF (lwp) WRITE(14,'(f10.4,1x,i8)') adatrj, ndastp 

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

    r359 r389  
    197197      !                        ! parameterize exchanges through straits 
    198198 
    199    !!---------------------------------------------------------------------- 
     199#if defined key_AGRIF 
     200   !!---------------------------------------------------------------------- 
     201   !! agrif sponge layer 
     202   !!---------------------------------------------------------------------- 
     203      LOGICAL :: spongedoneT = .FALSE. 
     204      REAL(wp), DIMENSION(jpi,jpj) :: zspe1ur, zspe2vr ,zspbtr2 
     205   !!---------------------------------------------------------------------- 
     206#endif 
     207 
    200208END MODULE dom_oce 

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

    r359 r389  
    9797      hu(:,:) = 0. 
    9898      hv(:,:) = 0. 
     99 
    99100      DO jk = 1, jpk 
    100101         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk) 
    … …  
    104105      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level 
    105106      hvr(:,:) = fse3v(:,:,1) 
     107       
    106108      DO jk = 2, jpk                      ! Sum of the vertical scale factors 
    107109         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk) 
    108110         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) 
    109111      END DO 
     112 
    110113      ! Compute and mask the inverse of the local depth 
    111114      hur(:,:) = 1. / hur(:,:) * umask(:,:,1) 
    … …  
    137140      !! * Modules used 
    138141      USE ioipsl 
    139       NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,          & 
    140          &             nitend, ndate0   , nleapy   , ninist , nstock,           & 
     142      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,         & 
     143         &             nitend, ndate0   , nleapy   , ninist , nstock,          & 
    141144         &             nprint, nwrite   , nrunoff  , ln_ctl , nictls, nictle,   & 
    142145         &             njctls, njctle   , nbench   , isplt  , jsplt 
    … …  
    261264      ENDIF 
    262265 
     266#if defined key_AGRIF 
     267      if ( Agrif_Root() ) then 
     268#endif 
    263269      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL 
    264270      CASE (  1 )  
    … …  
    272278         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    273279      END SELECT 
     280#if defined key_AGRIF 
     281      endif 
     282#endif 
    274283 
    275284      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ... 

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

    r352 r389  
    110110         zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg,   & 
    111111         zphi1, zsin_alpha, zim05, zjm05 
     112          
     113         real,dimension(:,:),pointer :: ffparent 
    112114      !!---------------------------------------------------------------------- 
    113115 
    … …  
    233235         glam0 = 0.e0 
    234236         gphi0 = - ppe2_m * 1.e-3 
     237          
     238#if defined key_AGRIF && defined key_eel_r6 
     239         IF (.Not.Agrif_Root()) THEN 
     240           glam0  = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 
     241           gphi0  = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 
     242           ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox() 
     243           ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy()           
     244         ENDIF 
     245#endif          
    235246         DO jj = 1, jpj 
    236247            DO ji = 1, jpi 
    … …  
    422433         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0 
    423434         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
     435          
     436#if defined key_AGRIF && defined key_eel_r6 
     437         IF (.Not.Agrif_Root()) THEN 
     438           zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
     439         ENDIF 
     440#endif          
    424441         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south 
    425442 
    426443         ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south) 
    427         
     444          
    428445         IF(lwp) WRITE(numout,*)  
    429446         IF(lwp) WRITE(numout,*) ' Beta-plane: Beta parameter = constant = ', ff(1,1) 
    … …  
    486503      !! * Local declarations 
    487504      LOGICAL ::   llog = .FALSE. 
    488       CHARACTER(len=21) ::   clname = 'coordinates' 
     505      CHARACTER(len=21) ::   clname 
    489506      INTEGER  ::   ji, jj              ! dummy loop indices 
    490507      INTEGER  ::   inum                ! temporary logical unit 
    … …  
    495512         zlamt, zphit, zdta             ! temporary workspace (NetCDF read) 
    496513      !!---------------------------------------------------------------------- 
     514      clname = 'coordinates' 
     515#if defined key_AGRIF 
     516      if ( .NOT. Agrif_Root() ) then 
     517         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     518      endif 
     519#endif          
    497520 
    498521 
    … …  
    515538         &                  itime , zdate0, zdt   , inum, domain_id=nidom ) 
    516539 
    517       CALL restget( inum, 'glamt', jpidta, jpjdta, 1, 0, llog, zdta ) 
     540      CALL restget( inum, 'glamt', jpidta, jpjdta, 1, itime, llog, zdta ) 
    518541      DO jj = 1, nlcj 
    519542         DO ji = 1, nlci 
    … …  
    521544         END DO 
    522545      END DO 
    523       CALL restget( inum, 'glamu', jpidta, jpjdta, 1, 0, llog, zdta ) 
     546      CALL restget( inum, 'glamu', jpidta, jpjdta, 1, itime, llog, zdta ) 
    524547      DO jj = 1, nlcj 
    525548         DO ji = 1, nlci 
    … …  
    527550         END DO 
    528551      END DO 
    529       CALL restget( inum, 'glamv', jpidta, jpjdta, 1, 0, llog, zdta ) 
     552      CALL restget( inum, 'glamv', jpidta, jpjdta, 1, itime, llog, zdta ) 
    530553      DO jj = 1, nlcj 
    531554         DO ji = 1, nlci 
    … …  
    533556         END DO 
    534557      END DO 
    535       CALL restget( inum, 'glamf', jpidta, jpjdta, 1, 0, llog, zdta ) 
     558      CALL restget( inum, 'glamf', jpidta, jpjdta, 1, itime, llog, zdta ) 
    536559      DO jj = 1, nlcj 
    537560         DO ji = 1, nlci 
    … …  
    539562         END DO 
    540563      END DO 
    541       CALL restget( inum, 'gphit', jpidta, jpjdta, 1, 0, llog, zdta ) 
     564      CALL restget( inum, 'gphit', jpidta, jpjdta, 1, itime, llog, zdta ) 
    542565      DO jj = 1, nlcj 
    543566         DO ji = 1, nlci 
    … …  
    545568         END DO 
    546569      END DO 
    547       CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, 0, llog, zdta ) 
     570      CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, itime, llog, zdta ) 
    548571      DO jj = 1, nlcj 
    549572         DO ji = 1, nlci 
    … …  
    551574         END DO 
    552575      END DO 
    553       CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, 0, llog, zdta ) 
     576      CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, itime, llog, zdta ) 
    554577      DO jj = 1, nlcj 
    555578         DO ji = 1, nlci 
    … …  
    557580         END DO 
    558581      END DO 
    559       CALL restget( inum, 'gphif', jpidta, jpjdta, 1, 0, llog, zdta ) 
     582      CALL restget( inum, 'gphif', jpidta, jpjdta, 1, itime, llog, zdta ) 
    560583      DO jj = 1, nlcj 
    561584         DO ji = 1, nlci 
    … …  
    563586         END DO 
    564587      END DO 
    565       CALL restget( inum, 'e1t', jpidta, jpjdta, 1, 0, llog, zdta ) 
     588      CALL restget( inum, 'e1t', jpidta, jpjdta, 1, itime, llog, zdta ) 
    566589      DO jj = 1, nlcj 
    567590         DO ji = 1, nlci 
    … …  
    569592         END DO 
    570593      END DO 
    571       CALL restget( inum, 'e1u', jpidta, jpjdta, 1, 0, llog, zdta ) 
     594      CALL restget( inum, 'e1u', jpidta, jpjdta, 1, itime, llog, zdta ) 
    572595      DO jj = 1, nlcj 
    573596         DO ji = 1, nlci 
    … …  
    575598         END DO 
    576599      END DO 
    577       CALL restget( inum, 'e1v', jpidta, jpjdta, 1, 0, llog, zdta ) 
     600      CALL restget( inum, 'e1v', jpidta, jpjdta, 1, itime, llog, zdta ) 
    578601      DO jj = 1, nlcj 
    579602         DO ji = 1, nlci 
    … …  
    581604         END DO 
    582605      END DO 
    583       CALL restget( inum, 'e1f', jpidta, jpjdta, 1, 0, llog, zdta ) 
     606      CALL restget( inum, 'e1f', jpidta, jpjdta, 1, itime, llog, zdta ) 
    584607      DO jj = 1, nlcj 
    585608         DO ji = 1, nlci 
    … …  
    587610         END DO 
    588611      END DO 
    589       CALL restget( inum, 'e2t', jpidta, jpjdta, 1, 0, llog, zdta ) 
     612      CALL restget( inum, 'e2t', jpidta, jpjdta, 1, itime, llog, zdta ) 
    590613      DO jj = 1, nlcj 
    591614         DO ji = 1, nlci 
    … …  
    593616         END DO 
    594617      END DO 
    595       CALL restget( inum, 'e2u', jpidta, jpjdta, 1, 0, llog, zdta ) 
     618      CALL restget( inum, 'e2u', jpidta, jpjdta, 1, itime, llog, zdta ) 
    596619      DO jj = 1, nlcj 
    597620         DO ji = 1, nlci 
    … …  
    599622         END DO 
    600623      END DO 
    601       CALL restget( inum, 'e2v', jpidta, jpjdta, 1, 0, llog, zdta ) 
     624      CALL restget( inum, 'e2v', jpidta, jpjdta, 1, itime, llog, zdta ) 
    602625      DO jj = 1, nlcj 
    603626         DO ji = 1, nlci 
    … …  
    605628         END DO 
    606629      END DO 
    607       CALL restget( inum, 'e2f', jpidta, jpjdta, 1, 0, llog, zdta ) 
     630      CALL restget( inum, 'e2f', jpidta, jpjdta, 1, itime, llog, zdta ) 
    608631      DO jj = 1, nlcj 
    609632         DO ji = 1, nlci 

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

    r352 r389  
    8787 
    8888      CHARACTER (len=21) ::      & 
    89          clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations) 
    90          clnam1 = 'mesh'    ,   &  ! filename (mesh informations) 
    91          clnam2 = 'mask'    ,   &  ! filename (mask informations) 
    92          clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations) 
    93          clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations) 
     89         clnam0  ,   &  ! filename (mesh and mask informations) 
     90         clnam1 ,   &  ! filename (mesh informations) 
     91         clnam2 ,   &  ! filename (mask informations) 
     92         clnam3 ,   &  ! filename (horizontal mesh informations) 
     93         clnam4         ! filename (vertical   mesh informations) 
    9494      !!---------------------------------------------------------------------- 
    9595 
    … …  
    9797       IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' 
    9898       IF(lwp) WRITE(numout,*) '~~~~~~~' 
     99 
     100         clnam0 = 'mesh_mask'  ! filename (mesh and mask informations) 
     101         clnam1 = 'mesh'       ! filename (mesh informations) 
     102         clnam2 = 'mask'       ! filename (mask informations) 
     103         clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations) 
     104         clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations) 
     105 
     106#if defined key_AGRIF 
     107      if ( .NOT. Agrif_Root() ) then 
     108        clnam0 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam0) 
     109        clnam1 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam1) 
     110        clnam2 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam2) 
     111        clnam3 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam3) 
     112        clnam4 = TRIM(Agrif_CFixed())//'_'//TRIM(clnam4) 
     113      endif 
     114#endif 
    99115 
    100116      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization 

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

    r381 r389  
    289289 
    290290      !! * Local declarations 
    291       CHARACTER (len=15) ::   clname    ! temporary characters 
     291      CHARACTER (len=18) ::   clname    ! temporary characters 
    292292      LOGICAL ::   llbon                ! check the existence of bathy files 
    293293      INTEGER ::   ji, jj, jl, jk       ! dummy loop indices 
    … …  
    380380         !  EEL R5 configuration with east and west open boundaries. 
    381381         !  Two rows of zeroes are needed at the south and north for OBCs 
    382          !  This is for compatibility with the rigid lid option.  
    383382           
    384383         IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 
    … …  
    390389      ELSEIF( ntopo == 1 ) THEN                       !   read in file  ! 
    391390         !                                            ! =============== ! 
    392          IF( lk_zco ) THEN 
    393             clname = 'bathy_level.nc'                       ! Level bathymetry 
    394             INQUIRE( FILE=clname, EXIST=llbon ) 
    395             IF( llbon ) THEN 
    396                IF(lwp) WRITE(numout,*) 
    397                IF(lwp) WRITE(numout,*) '         read level bathymetry in ', clname 
    398                IF(lwp) WRITE(numout,*) 
    399                itime = 1 
    400                ipi = jpidta 
    401                ipj = jpjdta 
    402                ipk = 1 
    403                zdt = rdt 
    404                CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   & 
    405                               ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 
    406                CALL flinget( inum, 'Bathy_level', jpidta, jpjdta, 1,   & 
    407                              itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 
    408                idta(:,:) = zdta(:,:) 
    409                CALL flinclo( inum ) 
    410  
    411             ELSE 
    412                IF(lwp) WRITE(numout,cform_err) 
    413                IF(lwp) WRITE(numout,*)'    zgr_bat : unable to read the file', clname 
    414                nstop = nstop + 1 
    415             ENDIF    
    416    
    417          ELSEIF( lk_zps ) THEN 
    418             clname = 'bathy_meter.nc'                       ! meter bathymetry 
    419             INQUIRE( FILE=clname, EXIST=llbon ) 
    420             IF( llbon ) THEN 
    421                IF(lwp) WRITE(numout,*) 
    422                IF(lwp) WRITE(numout,*) '         read meter bathymetry in ', clname 
    423                IF(lwp) WRITE(numout,*) 
    424                itime = 1 
    425                ipi = jpidta 
    426                ipj = jpjdta 
    427                ipk = 1 
    428                zdt = rdt 
    429                CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   &     
    430                               ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 
    431                CALL flinget( inum, 'Bathymetry', jpidta, jpjdta, 1,   & 
    432                              itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) )  
    433                CALL flinclo( inum ) 
    434             ELSE 
     391 
     392         clname = 'bathy_level.nc'                       ! Level bathymetry 
     393#if defined key_AGRIF 
     394      if ( .NOT. Agrif_Root() ) then 
     395         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     396      endif 
     397#endif          
     398         INQUIRE( FILE=clname, EXIST=llbon ) 
     399         IF( llbon ) THEN 
     400            IF(lwp) WRITE(numout,*) 
     401            IF(lwp) WRITE(numout,*) '         read level bathymetry in ', clname 
     402            IF(lwp) WRITE(numout,*) 
     403            itime = 1 
     404            ipi = jpidta 
     405            ipj = jpjdta 
     406            ipk = 1 
     407            zdt = rdt 
     408            CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   & 
     409                           ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 
     410            CALL flinget( inum, 'Bathy_level', jpidta, jpjdta, 1,   & 
     411                          itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 
     412            idta(:,:) = zdta(:,:) 
     413            CALL flinclo( inum ) 
     414 
     415         ELSE 
     416            IF(lwp) WRITE(numout,cform_err) 
     417            IF(lwp) WRITE(numout,*)'    zgr_bat : unable to read the file', clname 
     418            nstop = nstop + 1 
     419         ENDIF      
     420 
     421         clname = 'bathy_meter.nc'                       ! meter bathymetry 
     422#if defined key_AGRIF 
     423      if ( .NOT. Agrif_Root() ) then 
     424         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     425      endif 
     426#endif        
     427         INQUIRE( FILE=clname, EXIST=llbon ) 
     428         IF( llbon ) THEN 
     429            IF(lwp) WRITE(numout,*) 
     430            IF(lwp) WRITE(numout,*) '         read meter bathymetry in ', clname 
     431            IF(lwp) WRITE(numout,*) 
     432            itime = 1 
     433            ipi = jpidta 
     434            ipj = jpjdta 
     435            ipk = 1 
     436            zdt = rdt 
     437            CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   &     
     438                           ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 
     439            CALL flinget( inum, 'Bathymetry', jpidta, jpjdta, 1,   & 
     440                          itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) )  
     441            CALL flinclo( inum ) 
     442         ELSE 
     443            IF( lk_zps .OR. lk_sco ) THEN 
    435444               IF(lwp) WRITE(numout,cform_err)        
    436445               IF(lwp) WRITE(numout,*)'    zgr_bat : unable to read the file', clname 
    437446               nstop = nstop + 1 
     447            ELSE 
     448               zdta(:,:) = 0.e0 
     449               IF(lwp) WRITE(numout,*)'    zgr_bat : bathy_meter not found, but not used, bathy array set to zero' 
    438450            ENDIF 
    439451         ENDIF 
    … …  
    593605      IF( .NOT. lk_cfg_1d )   THEN 
    594606 
    595          ! Suppress isolated ocean grid points 
    596  
     607      ! Suppress isolated ocean grid points 
     608 
     609      IF(lwp) WRITE(numout,*) 
     610      IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points' 
     611      IF(lwp) WRITE(numout,*)'                   -----------------------------------' 
     612 
     613      icompt = 0 
     614       
     615      DO jl = 1, 2 
     616 
     617         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
     618            mbathy( 1 ,:) = mbathy(jpim1,:) 
     619            mbathy(jpi,:) = mbathy(  2  ,:) 
     620         ENDIF 
     621         DO jj = 2, jpjm1 
     622            DO ji = 2, jpim1 
     623               ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj),   & 
     624                  mbathy(ji,jj-1),mbathy(ji,jj+1) ) 
     625               IF( ibtest < mbathy(ji,jj) ) THEN 
     626                  IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   & 
     627                     'grid-point (i,j) =  ',ji,jj,' is changed from ',   & 
     628                     mbathy(ji,jj),' to ', ibtest 
     629                  mbathy(ji,jj) = ibtest 
     630                  icompt = icompt + 1 
     631               ENDIF 
     632            END DO 
     633         END DO 
     634 
     635      END DO 
     636      IF( icompt == 0 ) THEN 
     637         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points' 
     638      ELSE 
     639         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed' 
     640      ENDIF 
     641      IF( lk_mpp ) THEN 
     642         zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     643         CALL lbc_lnk( zbathy, 'T', 1. ) 
     644         mbathy(:,:) = INT( zbathy(:,:) ) 
     645      ENDIF 
     646 
     647      ! 3.2 East-west cyclic boundary conditions 
     648 
     649      IF( nperio == 0 ) THEN 
     650         IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west',   & 
     651            ' boundary: nperio = ', nperio 
     652         IF( lk_mpp ) THEN 
     653            IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     654               IF( jperio /= 1 )   mbathy(1,:) = 0 
     655            ENDIF 
     656            IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
     657               IF( jperio /= 1 )   mbathy(nlci,:) = 0 
     658            ENDIF 
     659         ELSE 
     660            mbathy( 1 ,:) = 0 
     661            mbathy(jpi,:) = 0 
     662         ENDIF 
     663      ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio ==  6 ) THEN 
     664         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions',   & 
     665            ' on mbathy: nperio = ', nperio 
     666         mbathy( 1 ,:) = mbathy(jpim1,:) 
     667         mbathy(jpi,:) = mbathy(  2  ,:) 
     668      ELSEIF( nperio == 2 ) THEN 
     669         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions',   & 
     670            ' on mbathy: nperio = ', nperio 
     671      ELSE 
     672         IF(lwp) WRITE(numout,*) '    e r r o r' 
     673         IF(lwp) WRITE(numout,*) '    parameter , nperio = ', nperio 
     674         !         STOP 'dom_mba' 
     675      ENDIF 
     676 
     677      ! Set to zero mbathy over islands if necessary  (lk_isl=F) 
     678      IF( .NOT. lk_isl ) THEN    ! No island 
    597679         IF(lwp) WRITE(numout,*) 
    598          IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points' 
    599          IF(lwp) WRITE(numout,*)'                   -----------------------------------' 
    600  
    601          icompt = 0 
    602  
    603          DO jl = 1, 2 
    604  
    605             IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
    606                mbathy( 1 ,:) = mbathy(jpim1,:) 
    607                mbathy(jpi,:) = mbathy(  2  ,:) 
    608             ENDIF 
    609             DO jj = 2, jpjm1 
    610                DO ji = 2, jpim1 
    611                   ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj),   & 
    612                      mbathy(ji,jj-1),mbathy(ji,jj+1) ) 
    613                   IF( ibtest < mbathy(ji,jj) ) THEN 
    614                      IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   & 
    615                         'grid-point (i,j) =  ',ji,jj,' is changed from ',   & 
    616                         mbathy(ji,jj),' to ', ibtest 
    617                      mbathy(ji,jj) = ibtest 
    618                      icompt = icompt + 1 
    619                   ENDIF 
    620                END DO 
    621             END DO 
    622  
    623          END DO 
    624          IF( icompt == 0 ) THEN 
    625             IF(lwp) WRITE(numout,*)'     no isolated ocean grid points' 
    626          ELSE 
    627             IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed' 
    628          ENDIF 
    629          IF( lk_mpp ) THEN 
    630             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
     680         IF(lwp) WRITE(numout,*) '         mbathy set to 0 over islands' 
     681         IF(lwp) WRITE(numout,*) '         ----------------------------' 
     682 
     683         mbathy(:,:) = MAX( 0, mbathy(:,:) ) 
     684 
     685         !  Boundary condition on mbathy 
     686         IF( .NOT.lk_mpp ) THEN  
     687             
     688       !!bug ???  y reflechir! 
     689            !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab 
     690             
     691       zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    631692            CALL lbc_lnk( zbathy, 'T', 1. ) 
    632693            mbathy(:,:) = INT( zbathy(:,:) ) 
    633694         ENDIF 
    634695 
    635          ! 3.2 East-west cyclic boundary conditions 
    636  
    637          IF( nperio == 0 ) THEN 
    638             IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west',   & 
    639                ' boundary: nperio = ', nperio 
    640             IF( lk_mpp ) THEN 
    641                IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    642                   IF( jperio /= 1 )   mbathy(1,:) = 0 
    643                ENDIF 
    644                IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    645                   IF( jperio /= 1 )   mbathy(nlci,:) = 0 
    646                ENDIF 
    647             ELSE 
    648                mbathy( 1 ,:) = 0 
    649                mbathy(jpi,:) = 0 
    650             ENDIF 
    651          ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio ==  6 ) THEN 
    652             IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions',   & 
    653                ' on mbathy: nperio = ', nperio 
    654             mbathy( 1 ,:) = mbathy(jpim1,:) 
    655             mbathy(jpi,:) = mbathy(  2  ,:) 
    656          ELSEIF( nperio == 2 ) THEN 
    657             IF(lwp) WRITE(numout,*) '   equatorial boundary conditions',   & 
    658                ' on mbathy: nperio = ', nperio 
    659          ELSE 
    660             IF(lwp) WRITE(numout,*) '    e r r o r' 
    661             IF(lwp) WRITE(numout,*) '    parameter , nperio = ', nperio 
    662             !         STOP 'dom_mba' 
    663          ENDIF 
    664  
    665          ! Set to zero mbathy over islands if necessary  (lk_isl=F) 
    666          IF( .NOT. lk_isl ) THEN    ! No island 
    667             IF(lwp) WRITE(numout,*) 
    668             IF(lwp) WRITE(numout,*) '         mbathy set to 0 over islands' 
    669             IF(lwp) WRITE(numout,*) '         ----------------------------' 
    670  
    671             mbathy(:,:) = MAX( 0, mbathy(:,:) ) 
    672  
    673             !  Boundary condition on mbathy 
    674             IF( .NOT.lk_mpp ) THEN  
    675                !!bug ???  y reflechir! 
    676                !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab 
    677                zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    678                CALL lbc_lnk( zbathy, 'T', 1. ) 
    679                mbathy(:,:) = INT( zbathy(:,:) ) 
    680             ENDIF 
    681  
    682          ENDIF 
     696      ENDIF 
    683697 
    684698      ENDIF 

  • trunk/NEMO/OPA_SRC/DOM/domzgr_zps.h90

    r253 r389  
    397397   IF(lwp) THEN 
    398398      WRITE(numout,*) ' e3t lev 21 ' 
    399       CALL prihre(e3t_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     399      CALL prihre(e3t_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    400400      WRITE(numout,*) ' e3w lev 21  ' 
    401       CALL prihre(e3w_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     401      CALL prihre(e3w_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    402402      WRITE(numout,*) ' e3u lev 21  ' 
    403       CALL prihre(e3u_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     403      CALL prihre(e3u_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    404404      WRITE(numout,*) ' e3v lev 21  ' 
    405       CALL prihre(e3v_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     405      CALL prihre(e3v_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    406406      WRITE(numout,*) ' e3f lev 21  ' 
    407       CALL prihre(e3f_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     407      CALL prihre(e3f_ps(:,:,21),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    408408      WRITE(numout,*) ' e3t lev 22 ' 
    409       CALL prihre(e3t_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     409      CALL prihre(e3t_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    410410      WRITE(numout,*) ' e3w lev 22  ' 
    411       CALL prihre(e3w_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     411      CALL prihre(e3w_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    412412      WRITE(numout,*) ' e3u lev 22  ' 
    413       CALL prihre(e3u_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     413      CALL prihre(e3u_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    414414      WRITE(numout,*) ' e3v lev 22  ' 
    415       CALL prihre(e3v_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     415      CALL prihre(e3v_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    416416      WRITE(numout,*) ' e3f lev 22  ' 
    417       CALL prihre(e3f_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
     417      CALL prihre(e3f_ps(:,:,22),jpi,jpj,50,59,1,1,5,1,0.,numout) 
    418418   ENDIF 
    419419 

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

    r247 r389  
    121121          
    122122         clname = 'data_1m_salinity_nomask' 
     123#if defined key_AGRIF 
     124         if ( .NOT. Agrif_Root() ) then 
     125            clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     126         endif 
     127#endif           
    123128         CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   & 
    124129              ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt) 
    … …  
    270275            WRITE(numout,*) 
    271276            WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1' 
    272             CALL prihre(saldta(1,1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     277            CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    273278            WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2 
    274             CALL prihre(saldta(1,1,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     279            CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    275280            WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1 
    276             CALL prihre(saldta(1,1,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     281            CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    277282         ENDIF 
    278283      ENDIF 

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

    r247 r389  
    9191      REAL(wp) ::   zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk) 
    9292      CHARACTER (len=45) ::   & 
    93          clname = "sst_1d.nc"      ! filename for daily SST 
     93         clname       ! filename for daily SST 
    9494      !!---------------------------------------------------------------------- 
    95  
     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          
    96101      IF( kt == nit000 ) THEN 
    97102         IF(lwp) WRITE(numout,*) 

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

    r247 r389  
    2828 
    2929   !! * Module variables 
    30    CHARACTER (len=38) ::   & 
    31       cl_tdata = 'data_1m_potential_temperature_nomask ' 
     30   CHARACTER (len=45) ::   & 
     31      cl_tdata 
    3232   INTEGER ::   & 
    3333      nlecte =  0,   &  ! switch for the first read 
    … …  
    9898      !!---------------------------------------------------------------------- 
    9999 
     100      cl_tdata = 'data_1m_potential_temperature_nomask ' 
     101 
     102#if defined key_AGRIF 
     103      if ( .NOT. Agrif_Root() ) then 
     104         cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 
     105      endif 
     106#endif          
    100107 
    101108      ! 0. Initialization 
    … …  
    262269            WRITE(numout,*) 
    263270            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1' 
    264             CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     271            CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    265272            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2 
    266             CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     273            CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    267274            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1 
    268             CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     275            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    269276         ENDIF 
    270277      ENDIF 

  • trunk/NEMO/OPA_SRC/DYN/divcur.F90

    r247 r389  
    117117               hdivn(ji,jj,jk) = (  e2u(ji,jj) * un(ji,jj,jk) - e2u(ji-1,jj  ) * un(ji-1,jj  ,jk)      & 
    118118                  &               + e1v(ji,jj) * vn(ji,jj,jk) - e1v(ji  ,jj-1) * vn(ji  ,jj-1,jk)  )   & 
    119                   &            / ( e1t(ji,jj) * e2t(ji,jj) ) 
     119     &            / ( e1t(ji,jj) * e2t(ji,jj) ) 
    120120#endif 
    121121            END DO 
    … …  
    130130         IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    131131#endif          
     132#if defined key_AGRIF 
     133         if ( .NOT. AGRIF_Root() ) then 
     134            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
     135            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
     136            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
     137            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
     138         endif 
     139#endif        
    132140 
    133141         !                                             ! -------- 
    … …  
    326334         IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
    327335#endif          
     336#if defined key_AGRIF 
     337         if ( .NOT. AGRIF_Root() ) then 
     338            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
     339            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
     340            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
     341            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
     342         endif 
     343#endif        
    328344         !                                             ! -------- 
    329345         ! relative vorticity                          !   rot  

  • trunk/NEMO/OPA_SRC/DYN/dynnxt.F90

    r367 r389  
    1919   USE lbclnk          ! lateral boundary condition (or mpp link) 
    2020   USE prtctl          ! Print control 
     21   USE agrif_opa_update 
     22   USE agrif_opa_interp 
    2123 
    2224   IMPLICIT NONE 
    … …  
    133135         !                                             ! =============== 
    134136# endif 
     137# if defined key_AGRIF 
     138         !                                             ! =============== 
     139      END DO                                           !   End of slab 
     140      !                                                ! =============== 
     141      ! Update (ua,va) along open boundaries (only in the rigid-lid case) 
     142      CALL Agrif_dyn( kt ) 
     143      !                                                ! =============== 
     144      DO jk = 1, jpkm1                                 ! Horizontal slab 
     145         !                                             ! =============== 
     146# endif 
    135147#endif 
    136148         ! Time filter and swap of dynamics arrays 
    … …  
    166178      ENDIF 
    167179 
     180#if defined key_AGRIF 
     181      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Dyn( kt ) 
     182#endif       
     183 
    168184   END SUBROUTINE dyn_nxt 
    169185 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r358 r389  
    3333   USE prtctl          ! Print control 
    3434   USE in_out_manager  ! I/O manager 
     35   USE agrif_opa_interp 
    3536 
    3637   IMPLICIT NONE 
    … …  
    163164         END DO 
    164165      END DO 
     166 
    165167#if defined key_obc 
    166168      ! Update velocities on each open boundary with the radiation algorithm 
    … …  
    168170      ! Correction of the barotropic componant velocity to control the volume of the system 
    169171      CALL obc_vol( kt ) 
     172#endif 
     173#if defined key_AGRIF 
     174      ! Update velocities on each coarse/fine interfaces 
     175 
     176      CALL Agrif_dyn( kt ) 
     177 
    170178#endif 
    171179#if defined key_orca_r2 
    … …  
    230238      ! applied the lateral boundary conditions 
    231239      IF( nsolv == 4 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1. )    
     240 
     241#if defined key_AGRIF 
     242 
     243       If (.NOT.AGRIF_ROOT()) THEN 
     244 
     245         ! add contribution of gradient of after barotropic transport divergence  
     246        IF ((nbondi == -1).OR.(nbondi == 2)) gcb(3,:) = gcb(3,:) & 
     247                        -znugdt * z2dt*laplacu(2,:)*gcdprc(3,:)*hu(2,:)*e2u(2,:) 
     248        IF ((nbondi == 1).OR.(nbondi == 2))  gcb(nlci-2,:) = gcb(nlci-2,:) & 
     249                       +znugdt * z2dt*laplacu(nlci-2,:)*gcdprc(nlci-2,:)*hu(nlci-2,:)*e2u(nlci-2,:) 
     250        IF ((nbondj == -1).OR.(nbondj == 2)) gcb(:,3) = gcb(:,3) & 
     251                       -znugdt * z2dt*laplacv(:,2)*gcdprc(:,3)*hv(:,2)*e1v(:,2) 
     252        IF ((nbondj == 1).OR.(nbondj == 2))  gcb(:,nlcj-2) = gcb(:,nlcj-2) & 
     253                       +znugdt * z2dt*laplacv(:,nlcj-2)*gcdprc(:,nlcj-2)*hv(:,nlcj-2)*e1v(:,nlcj-2) 
     254 
     255       ENDIF 
     256 
     257#endif 
     258 
    232259 
    233260      ! Relative precision (computation on one processor) 
    … …  
    288315      END DO 
    289316 
    290       ! Add the trends multiplied by z2dt to the after velocity 
    291       ! ------------------------------------------------------- 
     317#if defined key_AGRIF       
     318      IF (.NOT. Agrif_Root()) THEN 
     319      ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface 
     320        IF ((nbondi == -1).OR.(nbondi == 2)) spgu(2,:) = znugdt * z2dt * laplacu(2,:) * umask(2,:,1) 
     321        IF ((nbondi == 1).OR.(nbondi == 2)) spgu(nlci-2,:) = znugdt * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1) 
     322        IF ((nbondj == -1).OR.(nbondj == 2)) spgv(:,2) = znugdt * z2dt * laplacv(:,2) * vmask(:,2,1) 
     323        IF ((nbondj == 1).OR.(nbondj == 2)) spgv(:,nlcj-2) = znugdt * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1) 
     324      ENDIF 
     325#endif       
     326      ! 7.  Add the trends multiplied by z2dt to the after velocity 
     327      ! ----------------------------------------------------------- 
    292328      !     ( c a u t i o n : (ua,va) here are the after velocity not the 
    293329      !                       trend, the leap-frog time stepping will not 

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

    r367 r389  
    12731273     WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 
    12741274   END SUBROUTINE obc_dta 
     1275   SUBROUTINE obc_dta_bt( kt, jn)             ! Dummy routine 
     1276     INTEGER, INTENT (in) :: kt, jn 
     1277     WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 
     1278   END SUBROUTINE obc_dta_bt 
    12751279#endif 
    12761280 

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

    r247 r389  
    7979      REAL(wp), DIMENSION(jpk) ::   zlev           ! ??? 
    8080      CHARACTER(len=45)  ::  & 
    81          clname_n = 'tair_1d.nc',        & 
    82          clname_c = 'hum_cloud_1m.nc',   & 
    83          clname_x = 'rain_1m.nc',        & 
     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' 
    8489         clname_w = 'wspd_1d.nc' 
    8590      !!--------------------------------------------------------------------- 

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

    r319 r389  
    9595         zlon   , zlat                 ! ??? 
    9696      CHARACTER (len=32) ::   & 
    97          clname = 'flx.nc'             ! flux filename 
     97         clname            ! flux filename 
    9898      !!--------------------------------------------------------------------- 
     99         clname = 'flx.nc' 
    99100 
    100101 
    … …  
    131132 
    132133         ! 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     
    133139         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,   & 
    134140            &          .FALSE., ipi, ipj, ipk, zlon, zlat, zlev,   & 
    … …  
    202208               WRITE(numout,*) 
    203209               WRITE(numout,*) 'Clio mounth: ',nflx1,'  field: ',jm,' multiply by ',0.1 
    204                CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     210               CALL prihre(flxdta(:,:,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
    205211            END DO 
    206212         ENDIF 
    … …  
    269275               WRITE(numout,*) 'jpf =  ', jpf !C a u t i o n : information need for SX5NEC compilo bug 
    270276               WRITE(numout,*) 'Clio mounth: ',nflx11,'  field: ',jm,' multiply by ',0.1 
    271                CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     277               CALL prihre(flxdta(:,:,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
    272278               WRITE(numout,*) 
    273279            END DO 

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

    r247 r389  
    118118         ! Close/open file if new year  
    119119 
    120          IF( nyearflx /= 0 )   CALL flinclo(numflx) 
     120         IF( nyearflx /= 0 .AND. kt /= nit000 )   CALL flinclo(numflx) 
    121121 
    122122         iy = nyear 
    123123         IF(lwp) WRITE (numout,*) iy 
    124124         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          
    125130         IF(lwp) WRITE (numout,*)' open flx file = ',clname 
    126131         CALL FLUSH(numout) 
    … …  
    172177                  WRITE(numout,*) 
    173178                  WRITE(numout,*) ' Q * .1, day: ',ndastp 
    174                   CALL prihre(flxdta(1,1,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     179                  CALL prihre(flxdta(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
    175180                  WRITE(numout,*) 
    176181                  WRITE(numout,*) ' QSR * .1, day: ',ndastp 
    177                   CALL prihre(flxdta(1,1,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
     182                  CALL prihre(flxdta(:,:,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) 
    178183                  WRITE(numout,*) 
    179184                  WRITE(numout,*) ' E-P *86400, day: ',ndastp 
    180                   CALL prihre(flxdta(1,1,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout) 
     185                  CALL prihre(flxdta(:,:,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout) 
    181186                  WRITE(numout,*) ' ' 
    182187               ENDIF 

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

    r322 r389  
    104104# endif 
    105105      CHARACTER (len=32) ::   & 
    106          clname = 'runoff_1m_nomask'       ! monthly runoff filename 
     106         clname                            ! monthly runoff filename 
    107107      INTEGER, PARAMETER :: jpmois = 12 
    108108      INTEGER  ::   ipi, ipj, ipk          ! temporary integers 
    … …  
    117117         zcoefr                            ! coeff of advection link to runoff 
    118118      !!---------------------------------------------------------------------- 
     119         clname = 'runoff_1m_nomask'       ! monthly runoff filename 
    119120       
    120121      IF( kt == nit000 ) THEN 
    … …  
    266267         ! when reading the NetCDF file runoff_1m_nomask.nc 
    267268         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN 
    268             DO jj = 1, jpj 
    269                DO ji = 1, jpi 
    270                   IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   runoff(ji,jj) = 0.85 * runoff(ji,jj) 
    271                END DO 
     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) 
    272272            END DO 
     273         END DO 
    273274         ENDIF 
    274275          

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

    r247 r389  
    1414 
    1515   CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields 
    16       cl_taux = 'taux.nc',  & ! generic name of the i-component monthly NetCDF file 
    17       cl_tauy = 'tauy.nc'     ! generic name of the j-component monthly NetCDF file 
     16      cl_taux ,  & ! generic name of the i-component monthly NetCDF file 
     17      cl_tauy      ! generic name of the j-component monthly NetCDF file 
    1818   !!---------------------------------------------------------------------- 
    1919   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    6767      REAL(wp) ::   zsecond, zdate0 
    6868      !!--------------------------------------------------------------------- 
     69      cl_taux = 'taux.nc' 
     70      cl_tauy = 'tauy.nc' 
    6971 
    7072      ! -------------- ! 
    … …  
    9193         ENDIF 
    9294         ! 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 
    93100          
    94101         CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid 
    … …  
    110117            nstop = nstop + 1 
    111118         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 
    112124 
    113125         CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid 

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

    r319 r389  
    1414 
    1515   CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields 
    16       cl_taux = 'taux_1m.nc',  & ! generic name of the i-component monthly NetCDF file 
    17       cl_tauy = 'tauy_1m.nc'     ! generic name of the j-component monthly NetCDF file 
     16      cl_taux,  & ! generic name of the i-component monthly NetCDF file 
     17      cl_tauy     ! generic name of the j-component monthly NetCDF file 
    1818 
    1919   REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    … …  
    7777         zxy          ! coefficient of the linear time interpolation 
    7878      !!--------------------------------------------------------------------- 
     79      cl_taux = 'taux_1m.nc' 
     80      cl_tauy = 'tauy_1m.nc' 
    7981 
    8082      ! -------------- ! 
    … …  
    106108          
    107109         ! 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 
    108116          
    109117         CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid 
    … …  
    126134            nstop = nstop + 1 
    127135         ENDIF 
    128  
     136#if defined key_AGRIF 
     137      if ( .NOT. Agrif_Root() ) then 
     138         cl_tauy = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tauy) 
     139      endif 
     140#endif 
    129141         CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid 
    130142                        .FALSE., ipi   , ipj, ipk   ,        & 
    … …  
    185197            WRITE(numout,*) 
    186198            WRITE(numout,*) ' month: ', ntau1, '  taux: 1 multiply by ', 1. 
    187             CALL prihre( taux_dta(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 
     199            CALL prihre( taux_dta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 
    188200            WRITE(numout,*) 
    189201            WRITE(numout,*) ' month: ', ntau2, '  tauy: 2 multiply by ', 1. 
    190             CALL prihre( tauy_dta(1,1,2), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 
     202            CALL prihre( tauy_dta(:,:,2), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 
    191203         ENDIF 
    192204 

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

    r312 r389  
    6767      gccd             !: vector such that ca.gccd=a.d (ca-1=gcdprc) 
    6868 
     69#if defined key_AGRIF 
     70      REAL(wp), DIMENSION(jpi,jpj) :: laplacu, laplacv 
     71#endif 
     72 
    6973#if defined key_feti 
    7074   !!---------------------------------------------------------------------- 

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

    r359 r389  
    182182       
    183183!!cr  ENDIF 
     184#endif 
     185#if defined key_AGRIF 
     186       IF (.NOT.AGRIF_ROOT()) THEN 
     187        
     188       IF ( (nbondi == -1)  .OR. (nbondi == 2) ) bmask(2,:)=0. 
     189       IF ( (nbondi ==  1)  .OR. (nbondi == 2) ) bmask(nlci-1,:)=0. 
     190       IF ( (nbondj == -1)  .OR. (nbondj == 2) ) bmask(:,2)=0. 
     191       IF ( (nbondj ==  1)  .OR. (nbondj == 2) ) bmask(:,nlcj-1)=0. 
     192 
     193      DO jj = 2, jpjm1 
     194         DO ji = 2, jpim1 
     195            zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 
     196            !  south coefficient 
     197            IF( ((nbondj == -1)  .OR. (nbondj == 2)) .AND. ( jj == 3 ) ) THEN 
     198               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
     199            ELSE 
     200               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     201            END IF 
     202            gcp(ji,jj,1) = zcoefs 
     203 
     204            !  west coefficient 
     205       IF( ( (nbondi == -1)  .OR. (nbondi == 2) ) .AND. ( ji == 3 )  ) THEN 
     206               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
     207            ELSE 
     208               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     209            END IF 
     210            gcp(ji,jj,2) = zcoefw 
     211 
     212            !   east coefficient 
     213            IF( ((nbondi == 1)  .OR. (nbondi == 2)) .AND. ( ji == nlci-2 ) ) THEN 
     214               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1)) 
     215            ELSE 
     216               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     217            END IF 
     218            gcp(ji,jj,3) = zcoefe 
     219 
     220            !   north coefficient 
     221            IF( ((nbondj == 1)  .OR. (nbondj == 2)) .AND. ( jj == nlcj-2 ) ) THEN 
     222               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
     223            ELSE 
     224               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
     225            END IF 
     226            gcp(ji,jj,4) = zcoefn 
     227 
     228            ! diagonal coefficient 
     229            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 
     230                            - zcoefs -zcoefw -zcoefe -zcoefn 
     231         END DO 
     232      END DO 
     233       
     234       ENDIF 
    184235#endif 
    185236 

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

    r367 r389  
    7979      !! * Local declarations 
    8080      INTEGER :: ji, jj   ! dummy loop indices 
     81      CHARACTER(len=80) :: clname 
    8182 
    8283      NAMELIST/namsol/ nsolv, nsol_arp, nmin, nmax, nmod, eps, resmax, sor, epsisl, nmisl, rnu 
    … …  
    8889 
    8990      ! open elliptic solver statistics file 
    90       CALL ctlopn( numsol, 'solver.stat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   & 
     91      clname = 'solver.stat' 
     92      CALL ctlopn( numsol, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   & 
    9193                   1, numout, lwp, 1 ) 
    9294 

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

    r352 r389  
    189189         ! read the geothermal fluxes in mW/m2 
    190190         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     
    191196         itime = 1 
    192197         zlamt(:,:) = 0. 
    … …  
    195200         CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , 'NONE',   & 
    196201            &          itime, zdate0, zdt, inum, domain_id=nidom ) 
    197          CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, 0, .FALSE., zdta ) 
     202         CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, itime, .FALSE., zdta ) 
    198203         DO jj = 1, nlcj 
    199204            DO ji = 1, nlci 

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

    r352 r389  
    3535 
    3636   !! * Shared module variables 
    37    LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .TRUE.    !: internal damping flag 
     37   LOGICAL , PUBLIC & 
     38#if ! defined key_AGRIF 
     39   , PARAMETER  & 
     40#endif 
     41   ::   lk_tradmp = .TRUE.    !: internal damping flag 
    3842 
    3943   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 

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

    r258 r389  
    1616   USE obctra          ! open boundary condition (obc_tra routine) 
    1717   USE prtctl          ! Print control 
     18   USE agrif_opa_update 
     19   USE agrif_opa_interp 
    1820 
    1921   IMPLICIT NONE 
    … …  
    108110         !                                             ! =============== 
    109111#endif 
     112#if defined key_AGRIF 
     113         !                                             ! =============== 
     114      END DO                                           !   End of slab 
     115      !                                                ! =============== 
     116 
     117      ! Update tracers on open boundaries. 
     118      CALL Agrif_tra( kt ) 
     119 
     120      !                                                ! =============== 
     121      DO jk = 1, jpkm1                                 ! Horizontal slab 
     122         !                                             ! =============== 
     123#endif 
    110124 
    111125 
    … …  
    170184            &         tab3d_2=sn, clinfo2=' Sn: ', mask2=tmask) 
    171185      ENDIF 
     186       
     187#if defined key_AGRIF 
     188      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Tra( kt ) 
     189#endif       
    172190 
    173191   END SUBROUTINE tra_nxt 

  • trunk/NEMO/OPA_SRC/istate.F90

    r359 r389  
    330330            itime  = 0 
    331331            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                 
    332337            llog   = .FALSE. 
    333338            ilev   = jpk 

  • trunk/NEMO/OPA_SRC/lib_isml.f90

    r247 r389  
    118118      DIMENSION X(I) 
    119119      ISAMAX = 0 
    120       XMIN = -1e+50 
     120      XMIN = -huge(1.) 
    121121      DO N = 1, I 
    122122         IF(ABS(X(N)) > XMIN ) THEN 

  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r311 r389  
    9595   !!  MPI  variable definition !! 
    9696   !! ========================= !! 
     97!$AGRIF_DO_NOT_TREAT 
    9798#  include <mpif.h> 
     99!$AGRIF_END_DO_NOT_TREAT 
    98100 
    99101   INTEGER ::   & 
    … …  
    286288      CASE ( 'S' )                ! Standard mpi send (blocking) 
    287289         WRITE(numout,*) '           Standard blocking mpi send (send)' 
     290#if defined key_AGRIF 
     291         IF ( Agrif_Root() ) THEN 
     292#endif       
    288293         CALL mpi_init( ierr ) 
     294#if defined key_AGRIF 
     295         ENDIF 
     296#endif     
    289297      CASE ( 'B' )                ! Buffer mpi send (blocking) 
    290298         WRITE(numout,*) '           Buffer blocking mpi send (bsend)' 
     299#if defined key_AGRIF 
     300         IF ( Agrif_Root() ) THEN 
     301#endif       
    291302         CALL mpi_init_opa( ierr ) 
     303#if defined key_AGRIF 
     304         ENDIF 
     305#endif     
    292306      CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    293307         WRITE(numout,*) '           Immediate non-blocking send (isend)' 
    294308         l_isend = .TRUE. 
     309#if defined key_AGRIF 
     310         IF ( Agrif_Root() ) THEN 
     311#endif       
    295312         CALL mpi_init( ierr ) 
     313#if defined key_AGRIF 
     314         ENDIF 
     315#endif     
    296316      CASE DEFAULT 
    297317         WRITE(numout,cform_err) 
    … …  
    43984418   SUBROUTINE mpi_init_opa(code) 
    43994419      IMPLICIT NONE 
     4420 
     4421!$AGRIF_DO_NOT_TREAT 
    44004422#     include <mpif.h> 
     4423!$AGRIF_END_DO_NOT_TREAT 
    44014424 
    44024425      INTEGER                                 :: code,rang 

  • trunk/NEMO/OPA_SRC/mppini.F90

    r352 r389  
    143143         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace 
    144144      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
     145      CHARACTER(len=80) :: clname 
    145146      !!---------------------------------------------------------------------- 
    146147 
    … …  
    350351       IF (lwp) THEN 
    351352        inum = 11     
    352  
    353         OPEN(inum,FILE='layout.dat') 
     353        clname = 'layout.dat' 
     354        CALL ctlopn(inum, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 0) 
     355         
    354356        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
    355357        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 

  • trunk/NEMO/OPA_SRC/mppini_2.h90

    r290 r389  
    122122            clvar = 'Bathy_level' 
    123123         ENDIF 
     124#if defined key_AGRIF 
     125      if ( .NOT. Agrif_Root() ) then 
     126         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     127      endif 
     128#endif          
    124129 
    125130         INQUIRE( FILE=clname, EXIST=llbon ) 
    … …  
    588593         IF( ij == jpnj ) npolj = 5 
    589594      ENDIF 
    590        
     595 
    591596      ! Prepare NetCDF output file (if necessary) 
    592597      CALL mpp_init_ioipsl 

  • trunk/NEMO/OPA_SRC/opa.F90

    r367 r389  
    6060   !! * Routine accessibility 
    6161   PUBLIC opa_model      ! called by model.F90 
     62   PUBLIC opa_init 
    6263   !!---------------------------------------------------------------------- 
    6364   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    105106      !! * Local declarations 
    106107      INTEGER ::   istp       ! time step index 
    107 #if defined key_coupled 
    108       INTEGER ::   itro, istp0        ! ??? 
    109 #endif 
    110108      CHARACTER (len=64) ::        & 
    111109         cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    112       CHARACTER (len=28) :: file_out 
    113       !!---------------------------------------------------------------------- 
     110      !!---------------------------------------------------------------------- 
     111 
     112#if defined key_AGRIF 
     113 
     114      Call Agrif_Init_Grids() 
     115#endif 
    114116       
    115        
    116       ! Initializations 
    117       ! =============== 
    118  
    119       file_out = 'ocean.output' 
    120        
    121       ! open listing and namelist units 
    122       IF ( numout /= 0 .AND. numout /= 6 ) THEN  
    123          OPEN( UNIT=numout, FILE=TRIM(file_out), FORM='FORMATTED' ) 
    124       ENDIF 
    125  
    126       OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' ) 
    127  
    128       WRITE(numout,*) 
    129       WRITE(numout,*) '                 L O D Y C - I P S L' 
    130       WRITE(numout,*) '                     O P A model' 
    131       WRITE(numout,*) '            Ocean General Circulation Model' 
    132       WRITE(numout,*) '               version OPA 9.0  (2005) ' 
    133       WRITE(numout,*) 
    134       WRITE(numout,*) 
    135  
    136       ! Nodes selection 
    137       narea = mynode() 
    138       narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    139       lwp   = narea == 1 
    140  
    141       !                                     ! ============================== ! 
    142       !                                     !  Model general initialization  ! 
    143       !                                     ! ============================== ! 
    144  
    145       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    146  
    147                                             ! Domain decomposition 
    148       IF( jpni*jpnj == jpnij ) THEN 
    149          CALL mpp_init                          ! standard cutting out 
    150       ELSE 
    151          CALL mpp_init2                         ! eliminate land processors 
    152       ENDIF 
    153        
    154       CALL phy_cst                          ! Physical constants 
    155  
    156       CALL dom_cfg                          ! Domain configuration 
    157        
    158       CALL dom_init                         ! Domain 
    159  
    160       IF( ln_ctl )      CALL prt_ctl_init   ! Print control 
    161  
    162       IF( lk_cfg_1d )   CALL fcorio_1d      ! redefine Coriolis at T-point 
    163  
    164       IF( lk_obc    )   CALL obc_init       ! Open boundaries  
    165  
    166       IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN 
    167          CALL solver_init                   ! Elliptic solver 
    168       ENDIF 
    169  
    170       CALL day( nit000 )                    ! Calendar 
    171  
    172       CALL istate_init                      ! ocean initial state (Dynamics and tracers) 
    173 !!add 
    174                        CALL eos( tb, sb, rhd, rhop )        ! before potential and in situ densities 
    175  
    176                        CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency 
    177  
    178       IF( lk_zps .AND. .NOT. lk_cfg_1d )   & 
    179          &             CALL zps_hde( nit000, tb, sb, rhd,  &  ! Partial steps: before Horizontal DErivative 
    180                                             gtu, gsu, gru, &  ! of t, s, rd at the bottom ocean level 
    181                                             gtv, gsv, grv ) 
    182  
    183 !!add 
    184  
    185       CALL oc_fz_pt                         ! Surface freezing point 
    186  
    187 #if defined key_ice_lim 
    188       CALL ice_init                         ! Sea ice model 
    189 #endif 
    190  
    191       !                                     ! Ocean scheme 
    192  
    193       CALL opa_flg                              ! Choice of algorithms 
    194  
    195       !                                     ! Ocean physics 
    196  
    197       CALL tra_qsr_init                         ! Solar radiation penetration 
    198  
    199       CALL ldf_dyn_init                         ! Lateral ocean momentum physics 
    200  
    201       CALL ldf_tra_init                         ! Lateral ocean tracer physics 
    202  
    203       CALL zdf_init                             ! Vertical ocean physics 
    204  
    205       !                                     ! Ocean trends 
    206       ! Control parameters  
    207       IF( lk_trdtra .OR. lk_trdmld )   l_trdtra = .TRUE. 
    208       IF( lk_trddyn .OR. lk_trdvor )   l_trddyn = .TRUE. 
    209  
    210       IF( lk_trddyn .OR. lk_trdtra )   & 
    211          &            CALL trd_icp_init         ! active tracers and/or momentum 
    212  
    213       IF( lk_trdmld ) CALL trd_mld_init         ! mixed layer 
    214  
    215       IF( lk_trdvor ) CALL trd_vor_init         ! vorticity 
    216  
    217 #if defined key_passivetrc 
    218       CALL ini_trc                           ! Passive tracers 
    219 #endif 
    220  
    221 #if defined key_coupled 
    222       itro  = nitend - nit000 + 1           ! Coupled 
    223       istp0 = NINT( rdt ) 
    224       CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange 
    225 #endif 
    226  
    227       CALL flx_fwb_init                     ! FreshWater Budget correction 
    228  
    229       CALL dia_ptr_init                     ! Poleward TRansports initialization 
    230  
    231       !                                     ! =============== ! 
    232       !                                     !  time stepping  ! 
    233       !                                     ! =============== ! 
    234  
    235       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     117      Call opa_init  ! Initializations 
    236118 
    237119      IF( lk_cfg_1d  )  THEN  
    238          CALL init_1d 
    239120         istp = nit000 
    240121         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
     122#if defined key_AGRIF 
     123            CALL Agrif_Step(stp_1d) 
     124#else 
    241125            CALL stp_1d( istp ) 
     126#endif 
    242127            istp = istp + 1 
    243128         END DO 
    … …  
    245130         istp = nit000 
    246131         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
     132#if defined key_AGRIF 
     133            CALL Agrif_Step(stp) 
     134#else 
    247135            CALL stp( istp ) 
     136#endif 
    248137            istp = istp + 1 
    249138         END DO 
    … …  
    346235 
    347236   !!====================================================================== 
     237   SUBROUTINE opa_init 
     238      !!---------------------------------------------------------------------- 
     239      !!                     ***  ROUTINE opa_init  *** 
     240      !! 
     241      !! ** Purpose :   initialization of the opa model 
     242      !! 
     243      !! ** Method  :  
     244      !! 
     245      !! References : 
     246      !!---------------------------------------------------------------------- 
     247      !! * Local declarations 
     248 
     249#if defined key_coupled 
     250      INTEGER ::   itro, istp0        ! ??? 
     251#endif 
     252      CHARACTER (len=64) ::        & 
     253         cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
     254      CHARACTER (len=20) :: namelistname 
     255      CHARACTER (len=28) :: file_out 
     256      !!---------------------------------------------------------------------- 
     257 
     258      ! Initializations 
     259      ! =============== 
     260 
     261      file_out = 'ocean.output' 
     262       
     263      ! open listing and namelist units 
     264      IF ( numout /= 0 .AND. numout /= 6 ) THEN  
     265         CALL ctlopn(numout,file_out,'UNKNOWN', 'FORMATTED',   & 
     266                      'SEQUENTIAL',1,numout,.FALSE.,1) 
     267!         OPEN( UNIT=numout, FILE=TRIM(file_out), FORM='FORMATTED' ) 
     268      ENDIF 
     269 
     270      namelistname = 'namelist' 
     271      CALL ctlopn(numnam,namelistname,'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
     272                     1,numout,.FALSE.,1) 
     273!!!!      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' ) 
     274 
     275      WRITE(numout,*) 
     276      WRITE(numout,*) '                 L O D Y C - I P S L' 
     277      WRITE(numout,*) '                     O P A model' 
     278      WRITE(numout,*) '            Ocean General Circulation Model' 
     279      WRITE(numout,*) '               version OPA 9.0  (2005) ' 
     280      WRITE(numout,*) 
     281      WRITE(numout,*) 
     282 
     283      ! Nodes selection 
     284      narea = mynode() 
     285      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
     286      lwp   = narea == 1 
     287 
     288      !                                     ! ============================== ! 
     289      !                                     !  Model general initialization  ! 
     290      !                                     ! ============================== ! 
     291 
     292      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     293 
     294                                            ! Domain decomposition 
     295      IF( jpni*jpnj == jpnij ) THEN 
     296         CALL mpp_init                          ! standard cutting out 
     297      ELSE 
     298         CALL mpp_init2                         ! eliminate land processors 
     299      ENDIF 
     300       
     301      CALL phy_cst                          ! Physical constants 
     302 
     303      CALL dom_cfg                          ! Domain configuration 
     304       
     305      CALL dom_init                         ! Domain 
     306      IF( ln_ctl )      CALL prt_ctl_init   ! Print control 
     307 
     308      IF( lk_cfg_1d )   CALL fcorio_1d      ! redefine Coriolis at T-point 
     309 
     310      IF( lk_obc    )   CALL obc_init       ! Open boundaries  
     311 
     312      IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN 
     313      CALL solver_init                      ! Elliptic solver 
     314      ENDIF 
     315 
     316      CALL day( nit000 )                    ! Calendar 
     317 
     318      CALL istate_init                      ! ocean initial state (Dynamics and tracers) 
     319!!add 
     320                       CALL eos( tb, sb, rhd, rhop )        ! before potential and in situ densities 
     321 
     322                       CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency 
     323 
     324      IF( lk_zps .AND. .NOT. lk_cfg_1d )   & 
     325         &             CALL zps_hde( nit000, tb, sb, rhd,  &  ! Partial steps: before Horizontal DErivative 
     326                                            gtu, gsu, gru, &  ! of t, s, rd at the bottom ocean level 
     327                                            gtv, gsv, grv ) 
     328 
     329!!add 
     330 
     331      CALL oc_fz_pt                         ! Surface freezing point 
     332 
     333#if defined key_ice_lim 
     334      CALL ice_init                         ! Sea ice model 
     335#endif 
     336 
     337      !                                     ! Ocean scheme 
     338 
     339      CALL opa_flg                              ! Choice of algorithms 
     340 
     341      !                                     ! Ocean physics 
     342 
     343      CALL tra_qsr_init                         ! Solar radiation penetration 
     344 
     345      CALL ldf_dyn_init                         ! Lateral ocean momentum physics 
     346 
     347      CALL ldf_tra_init                         ! Lateral ocean tracer physics 
     348 
     349      CALL zdf_init                             ! Vertical ocean physics 
     350 
     351      !                                     ! Ocean trends 
     352      ! Control parameters  
     353      IF( lk_trdtra .OR. lk_trdmld )   l_trdtra = .TRUE. 
     354      IF( lk_trddyn .OR. lk_trdvor )   l_trddyn = .TRUE. 
     355 
     356      IF( lk_trddyn .OR. lk_trdtra )   & 
     357         &            CALL trd_icp_init         ! active tracers and/or momentum 
     358 
     359      IF( lk_trdmld ) CALL trd_mld_init         ! mixed layer 
     360 
     361      IF( lk_trdvor ) CALL trd_vor_init         ! vorticity 
     362 
     363#if defined key_passivetrc 
     364      CALL ini_trc                           ! Passive tracers 
     365#endif 
     366 
     367#if defined key_coupled 
     368      itro  = nitend - nit000 + 1           ! Coupled 
     369      istp0 = NINT( rdt ) 
     370      CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange 
     371#endif 
     372 
     373      CALL flx_fwb_init                     ! FreshWater Budget correction 
     374 
     375      CALL dia_ptr_init                     ! Poleward TRansports initialization 
     376 
     377      !                                     ! =============== ! 
     378      !                                     !  time stepping  ! 
     379      !                                     ! =============== ! 
     380 
     381      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     382 
     383      IF( lk_cfg_1d  )  THEN  
     384         CALL init_1d 
     385      ENDIF 
     386   END SUBROUTINE opa_init 
     387   !!====================================================================== 
    348388END MODULE opa 

  • trunk/NEMO/OPA_SRC/par_EEL_R2.h90

    r247 r389  
    88   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    99   !!---------------------------------------------------------------------- 
    10    CHARACTER (len=16), PARAMETER ::   &  !: 
     10   CHARACTER (len=16)      & 
     11#if !defined key_AGRIF 
     12      , PARAMETER  & 
     13#endif 
     14      ::    &   
    1115      cp_cfg = "eel"            !: name of the configuration 
    12    INTEGER, PARAMETER ::     &  !: 
     16   INTEGER     & 
     17#if !defined key_AGRIF 
     18      , PARAMETER  & 
     19#endif 
     20      :: & 
    1321      jp_cfg = 2   ,         &  !: resolution of the configuration (km) 
    1422 

  • trunk/NEMO/OPA_SRC/par_EEL_R5.h90

    r247 r389  
    88   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    99   !!---------------------------------------------------------------------- 
    10    CHARACTER (len=16), PARAMETER ::   &  !: 
     10   CHARACTER (len=16)      & 
     11#if !defined key_AGRIF 
     12      , PARAMETER  & 
     13#endif 
     14      ::    &   
     15   INTEGER     & 
     16#if !defined key_AGRIF 
     17      , PARAMETER  & 
     18#endif 
     19      :: & 
    1120      cp_cfg = "eel"            !: name of the configuration 
    12    INTEGER, PARAMETER ::     &  !: 
    1321      jp_cfg = 5      ,      &  !: resolution of the configuration (km) 
    1422 

  • trunk/NEMO/OPA_SRC/par_EEL_R6.h90

    r247 r389  
    88   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    99   !!---------------------------------------------------------------------- 
    10    CHARACTER (len=16), PARAMETER ::   &  !: 
     10   CHARACTER (len=16)      & 
     11#if !defined key_AGRIF 
     12      , PARAMETER  & 
     13#endif 
     14      ::    &   
    1115      cp_cfg = "eel"            !: name of the configuration 
    12    INTEGER, PARAMETER ::     &  !: 
     16   INTEGER     & 
     17#if !defined key_AGRIF 
     18      , PARAMETER  & 
     19#endif 
     20      ::     & 
    1321      jp_cfg = 6      ,      &  !: resolution of the configuration (km) 
    1422 
    … …  
    5361      !   The mercator grid starts only approximately at gphi0 because 
    5462      !   of the constraint that the equator be a T point. 
    55    REAL(wp) ,PARAMETER ::     &  !: 
     63   REAL(wp) & 
     64#if !defined key_AGRIF 
     65      , PARAMETER  & 
     66#endif 
     67      ::     &  !: 
    5668      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1) 
    5769      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1) 

  • trunk/NEMO/OPA_SRC/par_GYRE.h90

    r247 r389  
    88   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    99   !!---------------------------------------------------------------------- 
    10    CHARACTER (len=16), PARAMETER ::   &  !: 
     10   CHARACTER (len=16)      & 
     11#if !defined key_AGRIF 
     12      , PARAMETER  & 
     13#endif 
     14      ::    &   
    1115      cp_cfg = "gyre"           !: name of the configuration 
    12    INTEGER, PARAMETER ::     &  !: 
     16   INTEGER     & 
     17#if !defined key_AGRIF 
     18      , PARAMETER  & 
     19#endif 
     20      :: & 
    1321      jp_cfg =  1   ,        &  !:  
    1422 

  • trunk/NEMO/OPA_SRC/par_ORCA_R025.h90

    r248 r389  
    99   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1010   !!---------------------------------------------------------------------- 
    11    CHARACTER (len=16), PARAMETER ::   & 
     11   CHARACTER (len=16)      & 
     12#if !defined key_AGRIF 
     13      , PARAMETER  & 
     14#endif 
     15      ::    &   
    1216      cp_cfg = "orca"           !: name of the configuration 
    13    INTEGER, PARAMETER ::     & 
     17   INTEGER     & 
     18#if !defined key_AGRIF 
     19      , PARAMETER  & 
     20#endif 
     21      :: & 
    1422      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees) 
    1523      ! Original data size 

  • trunk/NEMO/OPA_SRC/par_ORCA_R05.h90

    r359 r389  
    99   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1010   !!---------------------------------------------------------------------- 
    11    CHARACTER (len=16), PARAMETER ::   & 
     11   CHARACTER (len=16)      & 
     12#if !defined key_AGRIF 
     13      , PARAMETER  & 
     14#endif 
     15      ::    &   
    1216      cp_cfg = "orca"           !: name of the configuration 
    13    INTEGER, PARAMETER ::     & 
     17   INTEGER     & 
     18#if !defined key_AGRIF 
     19      , PARAMETER  & 
     20#endif 
     21      :: & 
    1422      jp_cfg = 05  ,         &  !: resolution of the configuration (degrees) 
    1523 
    … …  
    2028 
    2129#if defined key_antarctic 
    22    INTEGER, PARAMETER ::     & 
    23       ! zoom domain size       !!! * antarctic zoom * 
     30      ! zoom domain size       !!! *  antarctic zoom  *  
     31   INTEGER     & 
     32#if !defined key_AGRIF 
     33      , PARAMETER  & 
     34#endif 
     35      :: & 
    2436      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i 
    2537      jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j  
    … …  
    3446 
    3547#elif defined key_arctic 
    36    INTEGER, PARAMETER ::     & 
     48      ! zoom domain size       !!! *  arctic zoom  * 
     49   INTEGER    & 
     50#if !defined key_AGRIF 
     51      , PARAMETER  & 
     52#endif 
     53      :: & 
    3754      ! zoom domain size       !!! *  arctic zoom  * 
    3855      jpiglo  = 562,         &  !: 1st dimension of global domain --> i 
    … …  
    4865 
    4966#else 
    50    INTEGER, PARAMETER ::     & 
    51       ! global domain size     !!! * full domain * 
     67      ! global domain size     !!! *  global domain  * 
     68   INTEGER    & 
     69#if !defined key_AGRIF 
     70      , PARAMETER  & 
     71#endif 
     72      :: & 
    5273      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i 
    5374      jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j 

  • trunk/NEMO/OPA_SRC/par_ORCA_R2.h90

    r359 r389  
    99   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1010   !!---------------------------------------------------------------------- 
    11    CHARACTER (len=16), PARAMETER ::    &   
     11   CHARACTER (len=16)      & 
     12#if !defined key_AGRIF 
     13      , PARAMETER  & 
     14#endif 
     15      ::    &   
    1216      cp_cfg = "orca"           !: name of the configuration  
    13    INTEGER, PARAMETER ::     & 
     17   INTEGER     & 
     18#if !defined key_AGRIF 
     19      , PARAMETER  & 
     20#endif 
     21      :: & 
    1422      jp_cfg = 2,            &  !: resolution of the configuration (degrees) 
    1523 
    … …  
    2129#if defined key_antarctic 
    2230      ! zoom domain size       !!! *  antarctic zoom  *  
    23    INTEGER, PARAMETER ::     & 
     31   INTEGER     & 
     32#if !defined key_AGRIF 
     33      , PARAMETER  & 
     34#endif 
     35      :: & 
    2436      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i 
    2537      jpjglo  = 50,          &  !: 2nd    "                  "    --> j 
    … …  
    3547#elif defined key_arctic 
    3648      ! zoom domain size       !!! *  arctic zoom  * 
    37    INTEGER, PARAMETER ::     & 
     49   INTEGER    & 
     50#if !defined key_AGRIF 
     51      , PARAMETER  & 
     52#endif 
     53      :: & 
    3854      jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i 
    3955      jpjglo  = jpjdta-97+1, &  !: 2nd    "                  "    --> j 
    … …  
    4965#elif defined key_cfg_1d 
    5066      ! global domain size     !!! *  global domain  * 
    51    INTEGER, PARAMETER ::     & 
     67   INTEGER    & 
     68#if !defined key_AGRIF 
     69      , PARAMETER  & 
     70#endif 
     71      :: & 
    5272      jpiglo  = 3     ,      &  !: 1st dimension of global domain --> i 
    5373      jpjglo  = 3     ,      &  !: 2nd    "                  "    --> j 
    … …  
    7494#else 
    7595      ! global domain size     !!! *  global domain  * 
    76    INTEGER, PARAMETER ::     & 
     96   INTEGER    & 
     97#if !defined key_AGRIF 
     98      , PARAMETER  & 
     99#endif 
     100      :: & 
    77101      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i 
    78102      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j 
    … …  
    85109      jpisl   =  18   ,      &  !: number of islands 
    86110      jpnisl  = 800             !: maximum number of points per island 
     111 
    87112#endif 
    88113 

  • trunk/NEMO/OPA_SRC/par_ORCA_R4.h90

    r247 r389  
    99   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1010   !!---------------------------------------------------------------------- 
    11    CHARACTER (len=16), PARAMETER ::    & 
    12       cp_cfg = "orca"           !: name of the configuration 
    13    INTEGER, PARAMETER ::     & 
     11   CHARACTER (len=16)      & 
     12#if !defined key_AGRIF 
     13      , PARAMETER  & 
     14#endif 
     15       ::    &   
     16     cp_cfg = "orca"           !: name of the configuration 
     17   INTEGER     & 
     18#if !defined key_AGRIF 
     19      , PARAMETER  & 
     20#endif 
     21      :: & 
    1422      jp_cfg = 4      ,      &  !: resolution of the configuration (degrees) 
    1523      ! Original data size 

  • trunk/NEMO/OPA_SRC/par_oce.F90

    r359 r389  
    168168   !! Domain Matrix size 
    169169   !!--------------------------------------------------------------------- 
    170    INTEGER, PUBLIC, PARAMETER ::   &  !: 
     170   INTEGER  &  !: 
     171#if !defined key_AGRIF 
     172      ,PARAMETER  & 
     173#endif 
     174    :: & 
    171175      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ,   &  !: first  dimension 
    172176      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ,   &  !: second dimension 
    … …  
    176180      jpij  = jpi*jpj                                               !:  jpi x jpj 
    177181 
     182#if defined key_AGRIF 
     183   !!--------------------------------------------------------------------- 
     184   !! Agrif variables 
     185   !!--------------------------------------------------------------------- 
     186   INTEGER, PUBLIC, PARAMETER :: nbghostcells = 1 
     187   INTEGER, PUBLIC :: nbcellsx = jpiglo - 2 - 2*nbghostcells 
     188   INTEGER, PUBLIC :: nbcellsy = jpjglo - 2 - 2*nbghostcells 
     189#endif 
    178190   !!--------------------------------------------------------------------- 
    179191   !! Optimization/control flags 

  • trunk/NEMO/OPA_SRC/restart.F90

    r367 r389  
    8888      REAL(wp), DIMENSION(10) ::   zinfo(10) 
    8989      REAL(wp), DIMENSION(jpi,jpj) :: ztab  
     90#if defined key_AGRIF 
     91       Integer :: knum 
     92#endif 
    9093      !!---------------------------------------------------------------------- 
    9194 
    … …  
    124127         INQUIRE( FILE=crestart, EXIST=llbon ) 
    125128         IF(llbon) THEN 
     129#if defined key_AGRIF 
     130       knum =Agrif_Get_Unit() 
     131            OPEN( UNIT=knum, FILE=crestart, STATUS='old' ) 
     132            CLOSE( knum, STATUS='delete' ) 
     133#else             
    126134            OPEN( UNIT=numwrs, FILE=crestart, STATUS='old' ) 
    127135            CLOSE( numwrs, STATUS='delete' ) 
     136#endif 
    128137         ENDIF 
    129138 
    … …  
    247256      LOGICAL ::   llog 
    248257      CHARACTER (len=8 ) ::   clvnames(50) 
    249       CHARACTER (len=32) ::   clname = 'restart' 
     258      CHARACTER (len=32) ::   clname 
    250259      INTEGER  ::   & 
    251260         itime, ibvar,     &  ! 
    … …  
    265274      !!  OPA 8.5, LODYC-IPSL (2002) 
    266275      !!---------------------------------------------------------------------- 
     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  
    267281 
    268282      IF(lwp) WRITE(numout,*) 

  • trunk/NEMO/OPA_SRC/restart_dimg.h90

    r359 r389  
    6262       irecl8= jpi * jpj * wp 
    6363       WRITE(clres,'(a,i3.3)') 'restart.output.',narea 
     64#if defined key_AGRIF  
     65       inum = Agrif_Get_Unit()       
     66       If(.NOT. Agrif_root() ) clres = TRIM(Agrif_CFixed())//'_'//TRIM(clres) 
     67#endif  
    6468       OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 ) 
    6569 
    … …  
    166170 
    167171       ! TKE arrays 
     172 
    168173#if defined key_zdftke 
    169174         DO jk = 1, jpk 
    170             WRITE(inum,REC=irec) en(:,:,jk)   ;  irec = irec + 1  
     175            WRITE(inum,REC=irec) en(:,:,jk) ; irec = irec + 1  
    171176         END DO 
    172177#endif 
    … …  
    174179#if defined key_ice_lim 
    175180          zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model 
    176           WRITE(inum,REC=irec) zfice(:)      ;  irec = irec + 1 
    177           WRITE(inum,REC=irec) sst_io(:,:)   ;  irec = irec + 1 
    178           WRITE(inum,REC=irec) sss_io(:,:)   ;  irec = irec + 1 
    179           WRITE(inum,REC=irec) u_io  (:,:)   ;  irec = irec + 1 
    180           WRITE(inum,REC=irec) v_io  (:,:)   ;  irec = irec + 1 
     181          WRITE(inum,REC=irec) zfice(:)     ; irec = irec + 1 
     182          WRITE(inum,REC=irec) sst_io(:,:)  ; irec = irec + 1 
     183          WRITE(inum,REC=irec) sss_io(:,:)  ; irec = irec + 1 
     184          WRITE(inum,REC=irec) u_io  (:,:)  ; irec = irec + 1 
     185          WRITE(inum,REC=irec) v_io  (:,:)  ; irec = irec + 1 
    181186#    if defined key_coupled 
    182           WRITE(inum,REC=irec) alb_ice(:,:)  ;   irec = irec + 1 
     187          WRITE(inum,REC=irec) alb_ice(:,:)  ; irec = irec + 1 
    183188#    endif 
    184189#endif 
    185190# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    186191          zfblk(1) = FLOAT( nfbulk )                                 ! Bulk 
    187           WRITE(inum,REC=irec) zfblk(:)   ;   irec = irec + 1 
    188           WRITE(inum,REC=irec) gsst(:,:)  ;   irec = irec + 1 
     192          WRITE(inum,REC=irec) zfblk(:)   ; irec = irec + 1 
     193          WRITE(inum,REC=irec) gsst(:,:)  ; irec = irec + 1 
    189194# endif 
    190195 
    … …  
    229234    LOGICAL   :: lstop 
    230235 
    231     REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk 
     236      REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk 
    232237    !!---------------------------------------------------------------------- 
    233238 
    … …  
    268273    ! Open direct access file, with reclength for 2D wp fields 
    269274    WRITE(clres,'(a,i3.3)') 'restart.',narea 
    270  
     275#if defined key_AGRIF        
     276    inum = Agrif_Get_Unit() 
     277    If(.NOT. Agrif_root() ) clres = TRIM(Agrif_CFixed())//'_'//TRIM(clres) 
     278#endif 
    271279    OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=8 ) 
    272280    READ(inum,REC=1)irecl8 
    … …  
    278286    ! -------------- 
    279287 
    280     READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1,   & 
    281        &             iice1, ibulk1, ios1, ios2, ios3, ios4,    & 
    282        &             idast1, adatrj0,  ipi,ipj,ipk,ipni,ipnj,ipnij,iarea 
     288 
     289    READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1, & 
     290     &  iice1, ibulk1, ios1, ios2, ios3, ios4, & 
     291     &  idast1, adatrj0,  ipi,ipj,ipk,ipni,ipnj,ipnij,iarea 
    283292 
    284293    ! Performs checks on the file 
    … …  
    416425 
    417426    ! TKE arrays 
     427 
    418428#if defined key_zdftke 
    419429    IF ( itke1 == 1 ) THEN 
    … …  
    433443    ! check if it was in the previous run 
    434444    IF ( ios1 == 1 ) THEN 
    435        READ(inum,REC=irec) zfice(:)      ;  irec = irec + 1 
    436        READ(inum,REC=irec) sst_io(:,:)   ;  irec = irec + 1 
    437        READ(inum,REC=irec) sss_io(:,:)   ;  irec = irec + 1 
    438        READ(inum,REC=irec) u_io  (:,:)   ;  irec = irec + 1 
    439        READ(inum,REC=irec) v_io  (:,:)   ;  irec = irec + 1 
    440 # if defined key_coupled 
    441        READ(inum,REC=irec) alb_ice(:,:)   ;  irec = irec + 1 
    442 # endif 
     445       READ(inum,REC=irec) zfice(:)    ; irec = irec + 1 
     446       READ(inum,REC=irec) sst_io(:,:) ; irec = irec + 1 
     447       READ(inum,REC=irec) sss_io(:,:) ; irec = irec + 1 
     448       READ(inum,REC=irec) u_io  (:,:) ; irec = irec + 1 
     449       READ(inum,REC=irec) v_io  (:,:) ; irec = irec + 1 
     450#  if defined key_coupled 
     451       READ(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1 
     452#  endif 
    443453    ENDIF 
    444454    IF ( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN 
    … …  
    454464            END DO 
    455465         END DO 
    456 # if defined key_coupled 
     466#    if defined key_coupled 
    457467         alb_ice(:,:) = 0.8 * tmask(:,:,1) 
    458 # endif 
     468#    endif 
    459469    ENDIF 
    460470#endif 
    … …  
    489499    ENDIF 
    490500 
     501 
    491502  END SUBROUTINE rst_read 

  • trunk/NEMO/OPA_SRC/step.F90

    r367 r389  
    118118   USE prtctl          ! Print control                    (prt_ctl routine) 
    119119 
     120#if defined key_AGRIF 
     121   USE agrif_opa_sponge ! Momemtum and tracers sponges 
     122#endif 
     123 
    120124   IMPLICIT NONE 
    121125   PRIVATE 
    … …  
    135139CONTAINS 
    136140 
    137    SUBROUTINE stp( kstp ) 
    138       !!---------------------------------------------------------------------- 
     141   SUBROUTINE stp( & 
     142#if !defined key_AGRIF 
     143   kstp & 
     144#endif    
     145   )      !!---------------------------------------------------------------------- 
    139146      !!                     ***  ROUTINE stp  *** 
    140147      !!                       
    … …  
    165172      !!    "   !  04-08  (C. Talandier) New trends organization 
    166173      !!    "   !  05-01  (C. Ethe) Add the KPP closure scheme 
    167       !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
    168174      !!---------------------------------------------------------------------- 
    169175      !! * Arguments 
    170       INTEGER, INTENT( in ) ::   kstp   ! ocean time-step index 
     176      INTEGER & 
     177#if !defined key_AGRIF    
     178      , INTENT( in ) & 
     179#endif       
     180      ::   kstp   ! ocean time-step index 
    171181 
    172182      !! * local declarations 
    … …  
    174184      !! --------------------------------------------------------------------- 
    175185 
     186#if defined key_AGRIF 
     187      kstp = nit000 + Agrif_Nb_Step() 
     188      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
     189      IF (lwp) Write(*,*) 'Grid N°',Agrif_Fixed(),' time step ',kstp 
     190#endif    
    176191      indic = 1                    ! reset to no error condition 
    177192      adatrj = adatrj + rdt/86400._wp 
    … …  
    321336      IF( l_traldf_iso_zps )   CALL tra_ldf_iso_zps( kstp )           ! partial step iso-neutral/geopot. laplacian 
    322337 
     338#if defined key_AGRIF 
     339      IF (.NOT. Agrif_Root())  CALL Agrif_Sponge_tra( kstp )          ! tracers sponge 
     340#endif 
    323341      !                                                       ! vertical diffusion 
    324342      IF( l_trazdf_exp     )   CALL tra_zdf_exp     ( kstp )          ! explicit time stepping (time splitting scheme) 
    … …  
    353371                               va(:,:,:) = 0.e0 
    354372 
    355                                CALL dyn_keg( kstp )           ! horizontal gradient of kinetic energy 
     373      CALL dyn_keg( kstp )           ! horizontal gradient of kinetic energy 
    356374 
    357375      !                                                       ! vorticity term including Coriolis 
    … …  
    361379      IF( ln_dynvor_mix    )   CALL dyn_vor_mixed    ( kstp )        ! mixed energy/enstrophy conserving scheme 
    362380      IF( ln_dynvor_een    )   CALL dyn_vor_ene_ens  ( kstp )        ! combined energy/enstrophy conserving scheme 
    363  
     381       
    364382      !                                                       ! lateral mixing  
    365383      IF( l_dynldf_lap     )   CALL dyn_ldf_lap    ( kstp )          ! iso-level laplacian 
    … …  
    368386      IF( l_dynldf_iso     )   CALL dyn_ldf_iso    ( kstp )          ! iso-neutral laplacian  
    369387 
     388#if defined key_AGRIF 
     389      IF (.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn( kstp )         ! momemtum sponge 
     390#endif 
    370391      !                                                       ! horizontal gradient of Hydrostatic pressure  
    371392      IF ( lk_jki ) THEN 
    … …  
    375396      ENDIF 
    376397 
    377                                CALL dyn_zad    ( kstp )       ! vertical advection        
     398      CALL dyn_zad    ( kstp )       ! vertical advection        
    378399 
    379400      !                                                       ! vertical diffusion 

  • trunk/NEMO/OPA_SRC/stpctl.F90

    r367 r389  
    5656      INTEGER, DIMENSION(3) ::   ilocu      !  
    5757      INTEGER, DIMENSION(2) ::   ilocs      !  
     58      CHARACTER(len=80) :: clname 
    5859      !!---------------------------------------------------------------------- 
    5960      !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    … …  
    6768         WRITE(numout,*) '~~~~~~~' 
    6869         ! open time.step file 
    69          CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
     70         clname = 'time.step' 
     71         CALL ctlopn( numstp, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
    7072      ENDIF 
    7173 
    … …  
    8082      ! -------------------------- 
    8183      IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN 
    82          ! Solver 
    83          IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps 
     84      ! Solver 
     85      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps 
    8486 
    85          ! Islands (if exist) 
    86          IF( lk_isl )   CALL isl_stp_ctl( kt, kindic ) 
     87      ! Islands (if exist) 
     88      IF( lk_isl )   CALL isl_stp_ctl( kt, kindic ) 
    8789 
    8890 
    89          ! Output in numwso and numwvo IF kindic<0 
    90          ! --------------------------------------- 
    91          !    (i.e. problem for the solver) 
    92          IF( kindic < 0 ) THEN 
    93             IF(lwp) THEN 
    94                WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode' 
    95                WRITE(numout,*) ' ====== ' 
    96                WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps 
    97                WRITE(numout,*) 
    98                WRITE(numout,*) ' stpctl: output of last fields in numwso' 
    99                WRITE(numout,*) '                                  numwvo' 
    100                WRITE(numout,*) ' ======  *******************************' 
    101             ENDIF 
    102             CALL dia_wri( kt, kindic ) 
     91      ! Output in numwso and numwvo IF kindic<0 
     92      ! --------------------------------------- 
     93      !    (i.e. problem for the solver) 
     94      IF( kindic < 0 ) THEN 
     95         IF(lwp) THEN 
     96            WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode' 
     97            WRITE(numout,*) ' ====== ' 
     98            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps 
     99            WRITE(numout,*) 
     100            WRITE(numout,*) ' stpctl: output of last fields in numwso' 
     101            WRITE(numout,*) '                                  numwvo' 
     102            WRITE(numout,*) ' ======  *******************************' 
    103103         ENDIF 
     104         CALL dia_wri( kt, kindic ) 
     105      ENDIF 
    104106      ENDIF 
    105107 
    … …  
    140142         ENDIF 
    141143         kindic  = -3 
     144 
    142145         CALL dia_wri( kt, kindic ) 
    143146      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.