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 3680 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC – NEMO

Ignore:
Timestamp:
2012-11-27T15:42:24+01:00 (11 years ago)
Author:
rblod
Message:

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028

Location:
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC
Files:
7 edited
3 copied

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif2model.F90

    r2528 r3680  
    55   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    66   !!---------------------------------------------------------------------- 
     7   SUBROUTINE Agrif2Model 
     8      !!--------------------------------------------- 
     9      !!   *** ROUTINE Agrif2Model *** 
     10      !!---------------------------------------------  
     11   END SUBROUTINE Agrif2model 
    712 
    813   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr) 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r3294 r3680  
    2525 
    2626   !                                              !!! OLD namelist names 
     27   INTEGER , PUBLIC ::   nbcline = 0               !: update counter 
    2728   INTEGER , PUBLIC ::   nbclineupdate             !: update frequency  
    2829   REAL(wp), PUBLIC ::   visc_tra                  !: sponge coeff. for tracers 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r3294 r3680  
    1 #define SPONGE 
     1#define SPONGE && define SPONGE_TOP 
    22 
    33Module agrif_opa_sponge 
    … …  
    1313   PRIVATE 
    1414 
    15    PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
    16  
     15   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
     16 
     17  !! * Substitutions 
     18#  include "domzgr_substitute.h90" 
    1719   !!---------------------------------------------------------------------- 
    1820   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    … …  
    2729      !!   *** ROUTINE Agrif_Sponge_Tra *** 
    2830      !!--------------------------------------------- 
    29 #include "domzgr_substitute.h90" 
    3031      !! 
    3132      INTEGER :: ji,jj,jk,jn 
    32       INTEGER :: spongearea 
    3333      REAL(wp) :: timecoeff 
    3434      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
    35       REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge 
    3635      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv 
    3736      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    … …  
    3938 
    4039#if defined SPONGE 
    41       CALL wrk_alloc( jpi, jpj, localviscsponge, ztu, ztv ) 
     40      CALL wrk_alloc( jpi, jpj, ztu, ztv ) 
    4241      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    4342 
    … …  
    5251      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 
    5352 
    54       spongearea = 2 + 2 * Agrif_irhox() 
    55  
    56       localviscsponge = 0. 
    57        
    58       IF (.NOT. spongedoneT) THEN 
    59          spe1ur(:,:) = 0. 
    60          spe2vr(:,:) = 0. 
    61  
    62       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    63          DO ji = 2, spongearea 
    64             localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 
    65          ENDDO 
    66      
    67     spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) & 
    68           * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:) 
    69  
    70          spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 
    71              localviscsponge(2:spongearea,2:jpj)) & 
    72            * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1) 
    73       ENDIF 
    74  
    75       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    76          DO ji = nlci-spongearea + 1,nlci-1 
    77             localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2) 
    78          ENDDO 
    79      
    80     spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 
    81            localviscsponge(nlci-spongearea + 2:nlci-1,:)) & 
    82           * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:) 
    83  
    84          spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 
    85               + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) & 
    86            * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1) 
    87       ENDIF 
    88  
    89  
    90       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    91          DO jj = 2, spongearea 
    92             localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2) 
    93          ENDDO 
    94      
    95     spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 
    96            localviscsponge(2:jpi,2:spongearea)) & 
    97           * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea) 
    98  
    99          spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 
    100              localviscsponge(:,3:spongearea)) & 
    101            * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1) 
    102       ENDIF 
    103  
    104       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    105          DO jj = nlcj-spongearea + 1,nlcj-1 
    106             localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2) 
    107          ENDDO 
    108      
    109     spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 
    110             localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) & 
    111           * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1) 
    112  
    113          spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 
    114             localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) & 
    115            * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2) 
    116       ENDIF 
    117        
    118          spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 
    119  
    120          spongedoneT = .TRUE. 
    121       ENDIF 
     53      CALL Agrif_Sponge 
    12254 
    12355      DO jn = 1, jpts 
    … …  
    14779      ENDDO 
    14880 
    149       CALL wrk_dealloc( jpi, jpj, localviscsponge, ztu, ztv ) 
     81      CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 
    15082      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    15183#endif 
    … …  
    15789      !!   *** ROUTINE Agrif_Sponge_dyn *** 
    15890      !!--------------------------------------------- 
    159 #include "domzgr_substitute.h90" 
    16091      !! 
    16192      INTEGER :: ji,jj,jk 
    162       INTEGER :: spongearea 
    16393      REAL(wp) :: timecoeff 
    16494      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    165       REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
    16695      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 
    16796      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff 
    … …  
    16998 
    17099#if defined SPONGE 
    171       CALL wrk_alloc( jpi, jpj, localviscsponge ) 
    172100      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    173101 
    … …  
    180108      Agrif_UseSpecialValue = .FALSE. 
    181109 
    182       ubdiff(:,:,:) = (ub(:,:,:) - ztab(:,:,:))*umask(:,:,:) 
     110      ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 
    183111 
    184112      ztab = 0.e0 
    … …  
    188116      Agrif_UseSpecialValue = .FALSE. 
    189117 
    190       vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:) 
    191  
    192       spongearea = 2 + 2 * Agrif_irhox() 
    193  
    194       localviscsponge = 0. 
    195  
    196       IF (.NOT. spongedoneU) THEN 
    197          spe1ur2(:,:) = 0. 
    198          spe2vr2(:,:) = 0. 
    199  
    200       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    201          DO ji = 2, spongearea 
    202             localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2) 
    203          ENDDO 
    204      
    205     spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) 
    206  
    207          spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 
    208              localviscsponge(2:spongearea,2:jpj)) 
    209       ENDIF 
    210  
    211       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    212          DO ji = nlci-spongearea + 1,nlci-1 
    213             localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2) 
    214          ENDDO 
    215      
    216     spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 
    217            localviscsponge(nlci-spongearea + 2:nlci-1,:)) 
    218  
    219          spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 
    220               + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) 
    221       ENDIF 
    222  
    223  
    224       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    225          DO jj = 2, spongearea 
    226             localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2) 
    227          ENDDO 
    228      
    229     spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 
    230            localviscsponge(2:jpi,2:spongearea)) 
    231  
    232          spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 
    233              localviscsponge(:,3:spongearea)) 
    234       ENDIF 
    235  
    236       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    237          DO jj = nlcj-spongearea + 1,nlcj-1 
    238             localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2) 
    239          ENDDO 
    240      
    241     spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 
    242             localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) 
    243  
    244          spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 
    245             localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) 
    246       ENDIF 
    247  
    248          spongedoneU = .TRUE. 
    249      
    250      spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:)) 
    251       ENDIF 
    252        
    253       IF (.NOT. spongedoneT) THEN 
    254         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))       
    255       ENDIF 
    256        
    257       DO jk=1,jpkm1 
    258       ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 
    259       vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 
     118      vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 
     119 
     120      CALL Agrif_Sponge 
     121 
     122      DO jk = 1,jpkm1 
     123         ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 
     124         vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 
    260125      ENDDO 
    261126       
    … …  
    272137            DO ji = 2, jpim1   ! vector opt. 
    273138               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    274                hdivdiff(ji,jj,jk) =   & 
    275                   (  e2u(ji,jj)*fse3u(ji,jj,jk) * &  
    276                   ubdiff(ji,jj,jk) - e2u(ji-1,jj  )* & 
    277                   fse3u(ji-1,jj  ,jk)  * ubdiff(ji-1,jj  ,jk)       & 
    278                   + e1v(ji,jj)*fse3v(ji,jj,jk) * & 
    279                   vbdiff(ji,jj,jk) - e1v(ji  ,jj-1)* & 
    280                   fse3v(ji  ,jj-1,jk)  * vbdiff(ji  ,jj-1,jk)  ) * zbtr 
     139               hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     & 
     140                  &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     & 
     141                  &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     & 
     142                  &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr 
    281143            END DO 
    282144         END DO 
    … …  
    286148               zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 
    287149               rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    & 
    288                   &              - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) & 
    289                   &           * fmask(ji,jj,jk) * zbtr 
     150                  &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) & 
     151                  &               * fmask(ji,jj,jk) * zbtr 
    290152            END DO 
    291153         END DO 
    … …  
    298160         DO jj = 2, jpjm1 
    299161            DO ji = 2, jpim1   ! vector opt. 
    300                ze2u = rotdiff (ji,jj,jk) 
    301                ze1v = hdivdiff(ji,jj,jk) 
    302162               ! horizontal diffusive trends 
    303                zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    304                   + ( hdivdiff(ji+1,jj,jk) - ze1v      & 
    305                   ) / e1u(ji,jj) 
    306  
    307                zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    308                   + ( hdivdiff(ji,jj+1,jk) - ze1v    & 
    309                   ) / e2v(ji,jj) 
    310  
     163               zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     164                     + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj) 
     165 
     166               zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     167                     + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj) 
    311168               ! add it to the general momentum trends 
    312169               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    … …  
    317174      END DO                                           !   End of slab 
    318175      !                                                ! =============== 
    319       CALL wrk_dealloc( jpi, jpj, localviscsponge ) 
    320176      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    321  
    322177#endif 
    323178 
    324179   END SUBROUTINE Agrif_Sponge_dyn 
    325180 
     181   SUBROUTINE Agrif_Sponge 
     182      !!--------------------------------------------- 
     183      !!   *** ROUTINE  Agrif_Sponge *** 
     184      !!--------------------------------------------- 
     185      INTEGER  :: ji,jj,jk 
     186      INTEGER  :: ispongearea, ilci, ilcj 
     187      REAL(wp) :: z1spongearea 
     188      REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge 
     189 
     190#if defined SPONGE || defined SPONGE_TOP 
     191 
     192      CALL wrk_alloc( jpi, jpj, zlocalviscsponge ) 
     193 
     194      ispongearea  = 2 + 2 * Agrif_irhox() 
     195      ilci = nlci - ispongearea 
     196      ilcj = nlcj - ispongearea  
     197      z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
     198      spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
     199 
     200      ! Tracers 
     201      IF( .NOT. spongedoneT ) THEN 
     202         zlocalviscsponge(:,:) = 0. 
     203         spe1ur(:,:) = 0. 
     204         spe2vr(:,:) = 0. 
     205 
     206         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
     207            DO ji = 2, ispongearea 
     208               zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea 
     209            ENDDO 
     210            spe1ur(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) + zlocalviscsponge(3:ispongearea,:    ) ) & 
     211               &                         * e2u(2:ispongearea-1,:      ) / e1u(2:ispongearea-1,:      ) 
     212            spe2vr(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) ) & 
     213               &                         * e1v(2:ispongearea  ,1:jpjm1) / e2v(2:ispongearea  ,1:jpjm1) 
     214         ENDIF 
     215 
     216         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     217            DO ji = ilci+1,nlci-1 
     218               zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea 
     219            ENDDO 
     220   
     221            spe1ur(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) )  & 
     222               &                                   * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 
     223 
     224            spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  ) &  
     225               &                                   * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 
     226         ENDIF 
     227 
     228         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
     229            DO jj = 2, ispongearea 
     230               zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea 
     231            ENDDO 
     232            spe1ur(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) ) & 
     233               &                                * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 
     234    
     235            spe2vr(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     + zlocalviscsponge(:,3:ispongearea)     ) & 
     236               &                                  * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 
     237         ENDIF 
     238 
     239         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
     240            DO jj = ilcj+1,nlcj-1 
     241               zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea 
     242            ENDDO 
     243            spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) ) & 
     244               &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 
     245            spe2vr(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) + zlocalviscsponge(:,ilcj+2:nlcj-1)     ) & 
     246               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 
     247         ENDIF 
     248         spongedoneT = .TRUE. 
     249      ENDIF 
     250 
     251      ! Dynamics 
     252      IF( .NOT. spongedoneU ) THEN 
     253         zlocalviscsponge(:,:) = 0. 
     254         spe1ur2(:,:) = 0. 
     255         spe2vr2(:,:) = 0. 
     256 
     257         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
     258            DO ji = 2, ispongearea 
     259               zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea 
     260            ENDDO 
     261            spe1ur2(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) + zlocalviscsponge(3:ispongearea,:    ) ) 
     262            spe2vr2(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) + zlocalviscsponge(2:ispongearea,2:jpj) )  
     263         ENDIF 
     264 
     265         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     266            DO ji = ilci+1,nlci-1 
     267               zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea 
     268            ENDDO 
     269            spe1ur2(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) + zlocalviscsponge(ilci+2:nlci-1,:) )   
     270            spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  )  
     271         ENDIF 
     272 
     273         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
     274            DO jj = 2, ispongearea 
     275               zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea 
     276            ENDDO 
     277            spe1ur2(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) + zlocalviscsponge(2:jpi,2:ispongearea) )  
     278            spe2vr2(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     + zlocalviscsponge(:,3:ispongearea)     ) 
     279         ENDIF 
     280 
     281         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
     282            DO jj = ilcj+1,nlcj-1 
     283               zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea 
     284            ENDDO 
     285            spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) )  
     286            spe2vr2(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) + zlocalviscsponge(:,ilcj+2:nlcj-1)     ) 
     287         ENDIF 
     288         spongedoneU = .TRUE. 
     289         spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) ) 
     290      ENDIF 
     291      ! 
     292      CALL wrk_dealloc( jpi, jpj, zlocalviscsponge ) 
     293      ! 
     294#endif 
     295 
     296   END SUBROUTINE Agrif_Sponge 
     297 
    326298   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
    327299      !!--------------------------------------------- 
    328300      !!   *** ROUTINE interptsn *** 
    329301      !!--------------------------------------------- 
    330 #  include "domzgr_substitute.h90"        
    331        
    332302      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    333303      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    341311      !!   *** ROUTINE interpun *** 
    342312      !!--------------------------------------------- 
    343 #  include "domzgr_substitute.h90"        
    344        
    345313      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    346314      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    … …  
    354322      !!   *** ROUTINE interpvn *** 
    355323      !!--------------------------------------------- 
    356 #  include "domzgr_substitute.h90"        
    357        
    358324      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    359325      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r3294 r3680  
    2727 
    2828   SUBROUTINE Agrif_trc 
    29       !!--------------------------------------------- 
    30       !!   *** ROUTINE Agrif_trc *** 
    31       !!--------------------------------------------- 
    32        
    33       INTEGER :: ji,jj,jk,jn 
    34       REAL(wp) :: zrhox 
    35       REAL(wp) :: alpha1, alpha2, alpha3, alpha4 
    36       REAL(wp) :: alpha5, alpha6, alpha7 
     29      !!---------------------------------------------------------------------- 
     30      !!                  ***  ROUTINE Agrif_Tra  *** 
     31      !!---------------------------------------------------------------------- 
     32      !! 
     33      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     34      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
     35      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    3736      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 
    38             
    39       IF (Agrif_Root()) RETURN 
     37      !!---------------------------------------------------------------------- 
     38      ! 
     39      IF( Agrif_Root() )   RETURN 
    4040 
    4141      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    4242 
    43       Agrif_SpecialValue=0. 
     43      Agrif_SpecialValue    = 0.e0 
    4444      Agrif_UseSpecialValue = .TRUE. 
    45       ztra = 0.e0 
     45      ztra(:,:,:,:) = 0.e0 
    4646 
    47       CALL Agrif_Bc_variable(ztra,trn_id, procname = interptrn ) 
     47      CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn ) 
    4848      Agrif_UseSpecialValue = .FALSE. 
    4949 
    5050      zrhox = Agrif_Rhox() 
    5151 
    52       alpha1 = (zrhox-1.)/2. 
    53       alpha2 = 1.-alpha1 
     52      alpha1 = ( zrhox - 1. ) * 0.5 
     53      alpha2 = 1. - alpha1 
    5454 
    55       alpha3 = (zrhox-1)/(zrhox+1) 
    56       alpha4 = 1.-alpha3 
     55      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     56      alpha4 = 1. - alpha3 
    5757 
    58       alpha6 = 2.*(zrhox-1.)/(zrhox+1.) 
    59       alpha7 = -(zrhox-1)/(zrhox+3) 
     58      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     59      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    6060      alpha5 = 1. - alpha6 - alpha7 
     61      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    6162 
    62       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    63          tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:) 
    64          DO jn=1,jptra  
    65             DO jk=1,jpk       
    66                DO jj=1,jpj 
    67                   IF (umask(nlci-2,jj,jk).EQ.0.) THEN 
     63         DO jn = 1, jptra 
     64            tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 
     65            DO jk = 1, jpkm1 
     66               DO jj = 1, jpj 
     67                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    6868                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    6969                  ELSE 
    7070                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    71                      IF (un(nlci-2,jj,jk).GT.0.) THEN 
    72                         tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 
    73                            +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     71                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     72                        tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  & 
     73                           &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     74                     ENDIF 
     75                  ENDIF 
     76               END DO 
     77            END DO 
     78         ENDDO 
     79      ENDIF 
     80 
     81      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
     82 
     83         DO jn = 1, jptra 
     84            tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 
     85            DO jk = 1, jpkm1 
     86               DO ji = 1, jpi 
     87                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     88                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     89                  ELSE 
     90                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 
     91                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     92                        tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  & 
     93                           &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     94                     ENDIF 
     95                  ENDIF 
     96               END DO 
     97            END DO 
     98         ENDDO 
     99      ENDIF 
     100      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
     101         DO jn = 1, jptra 
     102            tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 
     103            DO jk = 1, jpkm1 
     104               DO jj = 1, jpj 
     105                  IF( umask(2,jj,jk) == 0.e0 ) THEN 
     106                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
     107                  ELSE 
     108                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 
     109                     IF( un(2,jj,jk) < 0.e0 ) THEN 
     110                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    74111                     ENDIF 
    75112                  ENDIF 
    … …  
    79116      ENDIF 
    80117 
    81       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    82          tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:) 
    83          DO jn=1, jptra             
    84             DO jk=1,jpk       
     118      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
     119         DO jn = 1, jptra 
     120            tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 
     121            DO jk=1,jpk 
    85122               DO ji=1,jpi 
    86                   IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN 
    87                      tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     123                  IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     124                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    88125                  ELSE 
    89                      tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    90                      IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN 
    91                         tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 
    92                            +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk) 
     126                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
     127                     IF( vn(ji,2,jk) < 0.e0 ) THEN 
     128                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    93129                     ENDIF 
    94130                  ENDIF 
    95131               END DO 
    96132            END DO 
    97          END DO 
     133         ENDDO 
    98134      ENDIF 
    99  
    100       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    101          tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:) 
    102          DO jn=1, jptra 
    103             DO jk=1,jpk       
    104                DO jj=1,jpj 
    105                   IF (umask(2,jj,jk).EQ.0.) THEN 
    106                      tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
    107                   ELSE 
    108                      tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
    109                      IF (un(2,jj,jk).LT.0.) THEN 
    110                         tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) & 
    111                            +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    112                      ENDIF 
    113                   ENDIF 
    114                END DO 
    115             END DO 
    116          END DO 
    117       ENDIF 
    118  
    119       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    120          tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:) 
    121          DO jn=1, jptra   
    122             DO jk=1,jpk       
    123                DO ji=1,jpi 
    124                   IF (vmask(ji,2,jk).EQ.0.) THEN 
    125                      tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    126                   ELSE 
    127                      tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
    128                      IF (vn(ji,2,jk) .LT. 0.) THEN 
    129                         tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)& 
    130                            +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    131                      ENDIF 
    132                   ENDIF 
    133                END DO 
    134             END DO 
    135          END DO 
    136       ENDIF 
    137  
     135      ! 
    138136      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
     137      ! 
    139138 
    140139   END SUBROUTINE Agrif_trc 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r3294 r3680  
    88   USE in_out_manager 
    99   USE agrif_oce 
     10   USE agrif_opa_sponge 
    1011   USE trc 
    1112   USE lib_mpp 
    … …  
    1718   PUBLIC Agrif_Sponge_Trc, interptrn 
    1819 
     20  !! * Substitutions 
     21#  include "domzgr_substitute.h90" 
    1922   !!---------------------------------------------------------------------- 
    2023   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    … …  
    2932      !!   *** ROUTINE Agrif_Sponge_Trc *** 
    3033      !!--------------------------------------------- 
    31 #include "domzgr_substitute.h90" 
    3234      !!  
    33       INTEGER :: ji,jj,jk,jl 
    34       INTEGER :: spongearea 
     35      INTEGER :: ji,jj,jk,jn 
    3536      REAL(wp) :: timecoeff 
    3637      REAL(wp) :: ztra, zabe1, zabe2, zbtr 
    37       REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
    38       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab 
     38      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv 
     39      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr 
     40      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff 
    3941 
    4042#if defined SPONGE_TOP 
    41       CALL wrk_alloc( jpi, jpj, localviscsponge ) 
    42       CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab ) 
     43      CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 
     44      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 
    4345 
    4446      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    4648      Agrif_SpecialValue=0. 
    4749      Agrif_UseSpecialValue = .TRUE. 
    48       ztab = 0.e0 
    49       CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn) 
     50      ztabr = 0.e0 
     51      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 
    5052      Agrif_UseSpecialValue = .FALSE. 
    5153 
    52       trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab(:,:,:,:) 
     54      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:) 
    5355 
    54       spongearea = 2 + 2 * Agrif_irhox() 
     56      CALL Agrif_sponge 
    5557 
    56       localviscsponge = 0. 
    57        
    58       IF (.NOT. spongedoneT) THEN 
    59          spe1ur(:,:) = 0. 
    60          spe2vr(:,:) = 0. 
     58      DO jn = 1, jptra 
     59         DO jk = 1, jpkm1 
     60            ! 
     61            DO jj = 1, jpjm1 
     62               DO ji = 1, jpim1 
     63                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
     64                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
     65                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     66                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     67               ENDDO 
     68            ENDDO 
    6169 
    62       IF ((nbondi == -1).OR.(nbondi == 2)) THEN 
    63          DO ji = 2, spongearea 
    64             localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2) 
     70            DO jj = 2,jpjm1 
     71               DO ji = 2,jpim1 
     72                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     73                  ! horizontal diffusive trends 
     74                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  ) 
     75                  ! add it to the general tracer trends 
     76                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     77               END DO 
     78            END DO 
     79            ! 
    6580         ENDDO 
    66      
    67     spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) & 
    68           * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:) 
    69  
    70          spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + & 
    71              localviscsponge(2:spongearea,2:jpj)) & 
    72            * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1) 
    73       ENDIF 
    74  
    75       IF ((nbondi == 1).OR.(nbondi == 2)) THEN 
    76          DO ji = nlci-spongearea + 1,nlci-1 
    77             localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2) 
    78          ENDDO 
    79      
    80     spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + & 
    81            localviscsponge(nlci-spongearea + 2:nlci-1,:)) & 
    82           * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:) 
    83  
    84          spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) & 
    85               + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) & 
    86            * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1) 
    87       ENDIF 
    88  
    89  
    90       IF ((nbondj == -1).OR.(nbondj == 2)) THEN 
    91          DO jj = 2, spongearea 
    92             localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2) 
    93          ENDDO 
    94      
    95     spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + & 
    96            localviscsponge(2:jpi,2:spongearea)) & 
    97           * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea) 
    98  
    99          spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + & 
    100              localviscsponge(:,3:spongearea)) & 
    101            * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1) 
    102       ENDIF 
    103  
    104       IF ((nbondj == 1).OR.(nbondj == 2)) THEN 
    105          DO jj = nlcj-spongearea + 1,nlcj-1 
    106             localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2) 
    107          ENDDO 
    108      
    109     spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + & 
    110             localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) & 
    111           * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1) 
    112  
    113          spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + & 
    114             localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) & 
    115            * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2) 
    116       ENDIF 
    117        
    118          spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:)) 
    119  
    120          spongedoneT = .TRUE. 
    121       ENDIF 
    122  
    123       DO jl = 1, jptra 
    124       DO jk = 1, jpkm1 
    125          DO jj = 1, jpjm1 
    126             DO ji = 1, jpim1 
    127                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    128                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    129                ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) ) 
    130                ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) ) 
    131             ENDDO 
    132          ENDDO 
    133  
    134          DO jj = 2,jpjm1 
    135             DO ji = 2,jpim1 
    136                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    137                ! horizontal diffusive trends 
    138                ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   & 
    139                   &          + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl)  ) 
    140                ! add it to the general tracer trends 
    141                tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra) 
    142             END DO 
    143          END DO 
    144  
    145       ENDDO 
    14681      ENDDO 
    14782  
    148       CALL wrk_dealloc( jpi, jpj, localviscsponge ) 
    149       CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab ) 
     83      CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 
     84      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 
    15085 
    15186#endif 
    … …  
    15388   END SUBROUTINE Agrif_Sponge_Trc 
    15489 
    155    SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,l1,l2) 
     90   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
    15691      !!--------------------------------------------- 
    15792      !!   *** ROUTINE interptn *** 
    15893      !!--------------------------------------------- 
    159 #  include "domzgr_substitute.h90"        
    160        
    161       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 
    162       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 
    163  
    164       tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2) 
     94      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     95      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     96      ! 
     97      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    16598 
    16699   END SUBROUTINE interptrn 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r3294 r3680  
    3838 
    3939#if defined TWO_WAY 
    40       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztra ) 
     40      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    4141 
    4242      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    5252      nbcline_trc = nbcline_trc + 1 
    5353 
    54       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztra ) 
     54      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
    5555#endif 
    5656 
    5757   END SUBROUTINE Agrif_Update_Trc 
    5858 
    59    SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before) 
     59   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
    6060      !!--------------------------------------------- 
    6161      !!   *** ROUTINE UpdateTrc *** 
    6262      !!--------------------------------------------- 
    63 #  include "domzgr_substitute.h90" 
    64  
    65       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2 
    66       REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres 
     63      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     64      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    6765      LOGICAL, INTENT(in) :: before 
    6866    
    69       INTEGER :: ji,jj,jk,jl 
     67      INTEGER :: ji,jj,jk,jn 
    7068 
    71          IF (before) THEN 
    72             DO jl=l1,l2 
    73                DO jk=k1,k2 
    74                   DO jj=j1,j2 
    75                      DO ji=i1,i2 
    76                         tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl) 
     69         IF( before ) THEN 
     70            DO jn = n1, n2 
     71               DO jk = k1, k2 
     72                  DO jj = j1, j2 
     73                     DO ji = i1, i2 
     74                        tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    7775                     ENDDO 
    7876                  ENDDO 
    … …  
    8078            ENDDO 
    8179         ELSE 
    82             DO jl=l1,l2 
    83                DO jk=k1,k2 
    84                   DO jj=j1,j2 
    85                      DO ji=i1,i2 
    86                         IF (tabres(ji,jj,jk,jl).NE.0.) THEN 
    87                            trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk) 
     80            DO jn = n1, n2 
     81               DO jk = k1, k2 
     82                  DO jj = j1, j2 
     83                     DO ji = i1, i2 
     84                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
     85                           trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    8886                        ENDIF 
    8987                     ENDDO 

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r3294 r3680  
    11#if defined key_agrif 
    2    !!---------------------------------------------------------------------- 
    3    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    4    !! $Id$ 
    5    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6    !!---------------------------------------------------------------------- 
    7    SUBROUTINE agrif_before_regridding 
    8    END SUBROUTINE 
    9  
    10    SUBROUTINE Agrif_InitWorkspace 
    11       !!---------------------------------------------------------------------- 
    12       !!                 *** ROUTINE Agrif_InitWorkspace *** 
    13       !!---------------------------------------------------------------------- 
    14       USE par_oce 
    15       USE dom_oce 
    16       USE Agrif_Util 
    17       USE nemogcm 
    18       ! 
    19       IMPLICIT NONE 
    20       !!---------------------------------------------------------------------- 
    21       ! 
    22       IF( .NOT. Agrif_Root() ) THEN 
    23          jpni = Agrif_Parent(jpni) 
    24          jpnj = Agrif_Parent(jpnj) 
    25          jpnij = Agrif_Parent(jpnij) 
    26          jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    27          jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    28          jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    29          jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    30          jpk     = jpkdta 
    31          jpim1   = jpi-1 
    32          jpjm1   = jpj-1 
    33          jpkm1   = jpk-1                                         
    34          jpij    = jpi*jpj 
    35          jpidta  = jpiglo 
    36          jpjdta  = jpjglo 
    37          jpizoom = 1 
    38          jpjzoom = 1 
    39          nperio  = 0 
    40          jperio  = 0 
    41       ENDIF 
    42       ! 
    43    END SUBROUTINE Agrif_InitWorkspace 
    44  
    45  
    46    SUBROUTINE Agrif_InitValues 
    47       !!---------------------------------------------------------------------- 
    48       !!                 *** ROUTINE Agrif_InitValues *** 
    49       !! 
    50       !! ** Purpose :: Declaration of variables to be interpolated 
    51       !!---------------------------------------------------------------------- 
    52       USE Agrif_Util 
    53       USE oce  
    54       USE dom_oce 
    55       USE nemogcm 
    56       USE tradmp 
    57       USE obc_par 
    58       USE bdy_par 
    59  
    60       IMPLICIT NONE 
    61       !!---------------------------------------------------------------------- 
    62  
    63       ! 0. Initializations 
    64       !------------------- 
     2!!---------------------------------------------------------------------- 
     3!! NEMO/NST 3.4 , NEMO Consortium (2012) 
     4!! $Id$ 
     5!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     6!!---------------------------------------------------------------------- 
     7SUBROUTINE agrif_user 
     8END SUBROUTINE agrif_user 
     9 
     10SUBROUTINE agrif_before_regridding 
     11END SUBROUTINE agrif_before_regridding 
     12 
     13SUBROUTINE Agrif_InitWorkspace 
     14   !!---------------------------------------------------------------------- 
     15   !!                 *** ROUTINE Agrif_InitWorkspace *** 
     16   !!---------------------------------------------------------------------- 
     17   USE par_oce 
     18   USE dom_oce 
     19   USE Agrif_Util 
     20   USE nemogcm 
     21   ! 
     22   IMPLICIT NONE 
     23   !!---------------------------------------------------------------------- 
     24   ! 
     25   IF( .NOT. Agrif_Root() ) THEN 
     26      jpni = Agrif_Parent(jpni) 
     27      jpnj = Agrif_Parent(jpnj) 
     28      jpnij = Agrif_Parent(jpnij) 
     29      jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     30      jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     31      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     32      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     33      jpk     = jpkdta 
     34      jpim1   = jpi-1 
     35      jpjm1   = jpj-1 
     36      jpkm1   = jpk-1                                         
     37      jpij    = jpi*jpj 
     38      jpidta  = jpiglo 
     39      jpjdta  = jpjglo 
     40      jpizoom = 1 
     41      jpjzoom = 1 
     42      nperio  = 0 
     43      jperio  = 0 
     44   ENDIF 
     45   ! 
     46END SUBROUTINE Agrif_InitWorkspace 
     47 
     48 
     49SUBROUTINE Agrif_InitValues 
     50   !!---------------------------------------------------------------------- 
     51   !!                 *** ROUTINE Agrif_InitValues *** 
     52   !! 
     53   !! ** Purpose :: Declaration of variables to be interpolated 
     54   !!---------------------------------------------------------------------- 
     55   USE Agrif_Util 
     56   USE oce  
     57   USE dom_oce 
     58   USE nemogcm 
     59   USE tradmp 
     60   USE obc_par 
     61   USE bdy_par 
     62 
     63   IMPLICIT NONE 
     64   !!---------------------------------------------------------------------- 
     65 
     66   ! 0. Initializations 
     67   !------------------- 
    6568#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4 
    66       jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    67       cp_cfg = "default" 
     69   jp_cfg = -1    ! set special value for jp_cfg on fine grids 
     70   cp_cfg = "default" 
    6871#endif 
    6972 
    70       ! Specific fine grid Initializations 
    71       ! no tracer damping on fine grids 
    72       ln_tradmp = .FALSE. 
    73       ! no open boundary on fine grids 
    74       lk_obc = .FALSE. 
    75       lk_bdy = .FALSE. 
    76  
    77       CALL nemo_init  ! Initializations of each fine grid 
    78       CALL agrif_nemo_init 
     73   ! Specific fine grid Initializations 
     74   ! no tracer damping on fine grids 
     75   ln_tradmp = .FALSE. 
     76   ! no open boundary on fine grids 
     77   lk_obc = .FALSE. 
     78   lk_bdy = .FALSE. 
     79 
     80   CALL nemo_init  ! Initializations of each fine grid 
     81   CALL agrif_nemo_init 
     82   CALL Agrif_InitValues_cont_dom 
    7983# if ! defined key_offline 
    80       CALL Agrif_InitValues_cont 
     84   CALL Agrif_InitValues_cont 
    8185# endif        
    8286# if defined key_top 
    83       CALL Agrif_InitValues_cont_top 
     87   CALL Agrif_InitValues_cont_top 
    8488# endif       
    85    END SUBROUTINE Agrif_initvalues 
     89END SUBROUTINE Agrif_initvalues 
     90 
     91 
     92SUBROUTINE Agrif_InitValues_cont_dom 
     93   !!---------------------------------------------------------------------- 
     94   !!                 *** ROUTINE Agrif_InitValues_cont *** 
     95   !! 
     96   !! ** Purpose ::   Declaration of variables to be interpolated 
     97   !!---------------------------------------------------------------------- 
     98   USE Agrif_Util 
     99   USE oce  
     100   USE dom_oce 
     101   USE nemogcm 
     102   USE sol_oce 
     103   USE in_out_manager 
     104   USE agrif_opa_update 
     105   USE agrif_opa_interp 
     106   USE agrif_opa_sponge 
     107   ! 
     108   IMPLICIT NONE 
     109   ! 
     110   !!---------------------------------------------------------------------- 
     111 
     112   ! Declaration of the type of variable which have to be interpolated 
     113   !--------------------------------------------------------------------- 
     114   CALL agrif_declare_var_dom 
     115   ! 
     116END SUBROUTINE Agrif_InitValues_cont_dom 
     117 
     118 
     119SUBROUTINE agrif_declare_var_dom 
     120   !!---------------------------------------------------------------------- 
     121   !!                 *** ROUTINE agrif_declarE_var *** 
     122   !! 
     123   !! ** Purpose :: Declaration of variables to be interpolated 
     124   !!---------------------------------------------------------------------- 
     125   USE agrif_util 
     126   USE par_oce       !   ONLY : jpts 
     127   USE oce 
     128   IMPLICIT NONE 
     129   !!---------------------------------------------------------------------- 
     130 
     131   ! 1. Declaration of the type of variable which have to be interpolated 
     132   !--------------------------------------------------------------------- 
     133   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     134   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     135 
     136 
     137   ! 2. Type of interpolation 
     138   !------------------------- 
     139   Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     140   Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     141 
     142   ! 3. Location of interpolation 
     143   !----------------------------- 
     144   Call Agrif_Set_bc(e1u_id,(/0,0/)) 
     145   Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     146 
     147   ! 5. Update type 
     148   !---------------  
     149   Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     150   Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     151 
     152END SUBROUTINE agrif_declare_var_dom 
     153 
    86154 
    87155# if ! defined key_offline 
    88156 
    89    SUBROUTINE Agrif_InitValues_cont 
    90       !!---------------------------------------------------------------------- 
    91       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    92       !! 
    93       !! ** Purpose ::   Declaration of variables to be interpolated 
    94       !!---------------------------------------------------------------------- 
    95       USE Agrif_Util 
    96       USE oce  
    97       USE dom_oce 
    98       USE nemogcm 
    99       USE sol_oce 
    100       USE in_out_manager 
    101       USE agrif_opa_update 
    102       USE agrif_opa_interp 
    103       USE agrif_opa_sponge 
    104       ! 
    105       IMPLICIT NONE 
    106       ! 
    107       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
    108       REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    109       LOGICAL :: check_namelist 
    110       !!---------------------------------------------------------------------- 
    111  
    112       ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
    113       ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
    114  
    115  
    116       ! 1. Declaration of the type of variable which have to be interpolated 
    117       !--------------------------------------------------------------------- 
    118       CALL agrif_declare_var 
    119  
    120       ! 2. First interpolations of potentially non zero fields 
    121       !------------------------------------------------------- 
    122       Agrif_SpecialValue=0. 
    123       Agrif_UseSpecialValue = .TRUE. 
    124       Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
    125       Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
    126  
    127       Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
    128       Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
    129       Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
    130       Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    131       Agrif_UseSpecialValue = .FALSE. 
    132  
    133       ! 3. Some controls 
    134       !----------------- 
    135       check_namelist = .true. 
    136              
    137       IF( check_namelist ) THEN 
    138       
    139          ! Check time steps            
    140          IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    141             WRITE(*,*) 'incompatible time step between grids' 
    142             WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    143             WRITE(*,*) 'child  grid value : ',nint(rdt) 
    144             WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     157SUBROUTINE Agrif_InitValues_cont 
     158   !!---------------------------------------------------------------------- 
     159   !!                 *** ROUTINE Agrif_InitValues_cont *** 
     160   !! 
     161   !! ** Purpose ::   Declaration of variables to be interpolated 
     162   !!---------------------------------------------------------------------- 
     163   USE Agrif_Util 
     164   USE oce  
     165   USE dom_oce 
     166   USE nemogcm 
     167   USE sol_oce 
     168   USE in_out_manager 
     169   USE agrif_opa_update 
     170   USE agrif_opa_interp 
     171   USE agrif_opa_sponge 
     172   ! 
     173   IMPLICIT NONE 
     174   ! 
     175   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
     176   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
     177   LOGICAL :: check_namelist 
     178   !!---------------------------------------------------------------------- 
     179 
     180   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
     181   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
     182 
     183 
     184   ! 1. Declaration of the type of variable which have to be interpolated 
     185   !--------------------------------------------------------------------- 
     186   CALL agrif_declare_var 
     187 
     188   ! 2. First interpolations of potentially non zero fields 
     189   !------------------------------------------------------- 
     190   Agrif_SpecialValue=0. 
     191   Agrif_UseSpecialValue = .TRUE. 
     192   Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
     193   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
     194 
     195   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
     196   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
     197   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
     198   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
     199   Agrif_UseSpecialValue = .FALSE. 
     200 
     201   ! 3. Some controls 
     202   !----------------- 
     203   check_namelist = .true. 
     204 
     205   IF( check_namelist ) THEN 
     206 
     207      ! Check time steps            
     208      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
     209         WRITE(*,*) 'incompatible time step between grids' 
     210         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     211         WRITE(*,*) 'child  grid value : ',nint(rdt) 
     212         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     213         STOP 
     214      ENDIF 
     215 
     216      ! Check run length 
     217      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     218           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     219         WRITE(*,*) 'incompatible run length between grids' 
     220         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
     221              Agrif_Parent(nit000)+1),' time step' 
     222         WRITE(*,*) 'child  grid value : ', & 
     223              (nitend-nit000+1),' time step' 
     224         WRITE(*,*) 'value on child grid should be : ', & 
     225              Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     226              Agrif_Parent(nit000)+1) 
     227         STOP 
     228      ENDIF 
     229 
     230      ! Check coordinates 
     231      IF( ln_zps ) THEN 
     232         ! check parameters for partial steps  
     233         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     234            WRITE(*,*) 'incompatible e3zps_min between grids' 
     235            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     236            WRITE(*,*) 'child grid  :',e3zps_min 
     237            WRITE(*,*) 'those values should be identical' 
    145238            STOP 
    146239         ENDIF 
    147           
    148          ! Check run length 
    149          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    150             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    151             WRITE(*,*) 'incompatible run length between grids' 
    152             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    153                Agrif_Parent(nit000)+1),' time step' 
    154             WRITE(*,*) 'child  grid value : ', & 
    155                (nitend-nit000+1),' time step' 
    156             WRITE(*,*) 'value on child grid should be : ', & 
    157                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    158                Agrif_Parent(nit000)+1) 
     240         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
     241            WRITE(*,*) 'incompatible e3zps_rat between grids' 
     242            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     243            WRITE(*,*) 'child grid  :',e3zps_rat 
     244            WRITE(*,*) 'those values should be identical'                   
    159245            STOP 
    160246         ENDIF 
    161           
    162          ! Check coordinates 
    163          IF( ln_zps ) THEN 
    164             ! check parameters for partial steps  
    165             IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
    166                WRITE(*,*) 'incompatible e3zps_min between grids' 
    167                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    168                WRITE(*,*) 'child grid  :',e3zps_min 
    169                WRITE(*,*) 'those values should be identical' 
    170                STOP 
    171             ENDIF           
    172             IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    173                WRITE(*,*) 'incompatible e3zps_rat between grids' 
    174                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    175                WRITE(*,*) 'child grid  :',e3zps_rat 
    176                WRITE(*,*) 'those values should be identical'                   
    177                STOP 
    178             ENDIF 
     247      ENDIF 
     248   ENDIF 
     249 
     250   CALL Agrif_Update_tra(0) 
     251   CALL Agrif_Update_dyn(0) 
     252 
     253   nbcline = 0 
     254   ! 
     255   DEALLOCATE(tabtstemp) 
     256   DEALLOCATE(tabuvtemp) 
     257   ! 
     258END SUBROUTINE Agrif_InitValues_cont 
     259 
     260 
     261SUBROUTINE agrif_declare_var 
     262   !!---------------------------------------------------------------------- 
     263   !!                 *** ROUTINE agrif_declarE_var *** 
     264   !! 
     265   !! ** Purpose :: Declaration of variables to be interpolated 
     266   !!---------------------------------------------------------------------- 
     267   USE agrif_util 
     268   USE par_oce       !   ONLY : jpts 
     269   USE oce 
     270   IMPLICIT NONE 
     271   !!---------------------------------------------------------------------- 
     272 
     273   ! 1. Declaration of the type of variable which have to be interpolated 
     274   !--------------------------------------------------------------------- 
     275   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     276   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
     277   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
     278 
     279   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
     280   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
     281   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
     282   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
     283 
     284   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     285   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
     286 
     287   ! 2. Type of interpolation 
     288   !------------------------- 
     289   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     290   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
     291 
     292   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     293   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     294 
     295   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     296   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     297 
     298   ! 3. Location of interpolation 
     299   !----------------------------- 
     300   Call Agrif_Set_bc(un_id,(/0,1/)) 
     301   Call Agrif_Set_bc(vn_id,(/0,1/)) 
     302 
     303   Call Agrif_Set_bc(tsn_id,(/0,1/)) 
     304   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
     305 
     306   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
     307   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     308 
     309   ! 5. Update type 
     310   !---------------  
     311   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     312   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
     313 
     314   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     315   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
     316 
     317   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     318   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     319 
     320END SUBROUTINE agrif_declare_var 
     321# endif 
     322 
     323#  if defined key_lim2 
     324SUBROUTINE Agrif_InitValues_cont_lim2 
     325   !!---------------------------------------------------------------------- 
     326   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 *** 
     327   !! 
     328   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2 
     329   !!---------------------------------------------------------------------- 
     330   USE Agrif_Util 
     331   USE ice_2 
     332   USE agrif_ice 
     333   USE in_out_manager 
     334   USE agrif_lim2_update 
     335   USE agrif_lim2_interp 
     336   USE lib_mpp 
     337   ! 
     338   IMPLICIT NONE 
     339   ! 
     340   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel 
     341   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv 
     342   !!---------------------------------------------------------------------- 
     343 
     344   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7)) 
     345 
     346   ! 1. Declaration of the type of variable which have to be interpolated 
     347   !--------------------------------------------------------------------- 
     348   CALL agrif_declare_var_lim2 
     349 
     350   ! 2. First interpolations of potentially non zero fields 
     351   !------------------------------------------------------- 
     352   Agrif_SpecialValue=-9999. 
     353   Agrif_UseSpecialValue = .TRUE. 
     354   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice ) 
     355   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   ) 
     356   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   ) 
     357   Agrif_SpecialValue=0. 
     358   Agrif_UseSpecialValue = .FALSE. 
     359 
     360   ! 3. Some controls 
     361   !----------------- 
     362 
     363#   if ! defined key_lim2_vp 
     364   lim_nbstep = 1. 
     365   CALL agrif_rhg_lim2_load 
     366   CALL agrif_trp_lim2_load 
     367   lim_nbstep = 0. 
     368#   endif 
     369   !RB mandatory but why ??? 
     370   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN 
     371   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc') 
     372   !         nbclineupdate = nn_fsbc 
     373   !       ENDIF 
     374   CALL Agrif_Update_lim2(0) 
     375   ! 
     376   DEALLOCATE( zvel, zadv ) 
     377   ! 
     378END SUBROUTINE Agrif_InitValues_cont_lim2 
     379 
     380SUBROUTINE agrif_declare_var_lim2 
     381   !!---------------------------------------------------------------------- 
     382   !!                 *** ROUTINE agrif_declare_var_lim2 *** 
     383   !! 
     384   !! ** Purpose :: Declaration of variables to be interpolated for LIM2 
     385   !!---------------------------------------------------------------------- 
     386   USE agrif_util 
     387   USE ice_2 
     388 
     389   IMPLICIT NONE 
     390   !!---------------------------------------------------------------------- 
     391 
     392   ! 1. Declaration of the type of variable which have to be interpolated 
     393   !--------------------------------------------------------------------- 
     394   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id ) 
     395#   if defined key_lim2_vp 
     396   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
     397   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
     398#   else 
     399   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
     400   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
     401#   endif 
     402 
     403   ! 2. Type of interpolation 
     404   !------------------------- 
     405   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 
     406   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     407   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     408 
     409   ! 3. Location of interpolation 
     410   !----------------------------- 
     411   Call Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
     412   Call Agrif_Set_bc(u_ice_id,(/0,1/)) 
     413   Call Agrif_Set_bc(v_ice_id,(/0,1/)) 
     414 
     415   ! 5. Update type 
     416   !--------------- 
     417   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
     418   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     419   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     420 
     421END SUBROUTINE agrif_declare_var_lim2 
     422#  endif 
     423 
     424 
     425# if defined key_top 
     426SUBROUTINE Agrif_InitValues_cont_top 
     427   !!---------------------------------------------------------------------- 
     428   !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
     429   !! 
     430   !! ** Purpose :: Declaration of variables to be interpolated 
     431   !!---------------------------------------------------------------------- 
     432   USE Agrif_Util 
     433   USE oce  
     434   USE dom_oce 
     435   USE nemogcm 
     436   USE par_trc 
     437   USE trc 
     438   USE in_out_manager 
     439   USE agrif_top_update 
     440   USE agrif_top_interp 
     441   USE agrif_top_sponge 
     442   ! 
     443   IMPLICIT NONE 
     444   ! 
     445   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     446   LOGICAL :: check_namelist 
     447   !!---------------------------------------------------------------------- 
     448 
     449   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
     450 
     451 
     452   ! 1. Declaration of the type of variable which have to be interpolated 
     453   !--------------------------------------------------------------------- 
     454   CALL agrif_declare_var_top 
     455 
     456   ! 2. First interpolations of potentially non zero fields 
     457   !------------------------------------------------------- 
     458   Agrif_SpecialValue=0. 
     459   Agrif_UseSpecialValue = .TRUE. 
     460   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 
     461   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
     462   Agrif_UseSpecialValue = .FALSE. 
     463 
     464   ! 3. Some controls 
     465   !----------------- 
     466   check_namelist = .true. 
     467 
     468   IF( check_namelist ) THEN 
     469#  if defined offline      
     470      ! Check time steps 
     471      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     472         WRITE(*,*) 'incompatible time step between grids' 
     473         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
     474         WRITE(*,*) 'child  grid value : ',nint(rdt) 
     475         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
     476         STOP 
     477      ENDIF 
     478 
     479      ! Check run length 
     480      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     481           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
     482         WRITE(*,*) 'incompatible run length between grids' 
     483         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
     484              Agrif_Parent(nit000)+1),' time step' 
     485         WRITE(*,*) 'child  grid value : ', & 
     486              (nitend-nit000+1),' time step' 
     487         WRITE(*,*) 'value on child grid should be : ', & 
     488              Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     489              Agrif_Parent(nit000)+1) 
     490         STOP 
     491      ENDIF 
     492 
     493      ! Check coordinates 
     494      IF( ln_zps ) THEN 
     495         ! check parameters for partial steps  
     496         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     497            WRITE(*,*) 'incompatible e3zps_min between grids' 
     498            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     499            WRITE(*,*) 'child grid  :',e3zps_min 
     500            WRITE(*,*) 'those values should be identical' 
     501            STOP 
     502         ENDIF 
     503         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     504            WRITE(*,*) 'incompatible e3zps_rat between grids' 
     505            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     506            WRITE(*,*) 'child grid  :',e3zps_rat 
     507            WRITE(*,*) 'those values should be identical'                   
     508            STOP 
    179509         ENDIF 
    180510      ENDIF 
    181         
    182       CALL Agrif_Update_tra(0) 
    183       CALL Agrif_Update_dyn(0) 
    184  
    185       nbcline = 0 
    186       ! 
    187       DEALLOCATE(tabtstemp) 
    188       DEALLOCATE(tabuvtemp) 
    189       ! 
    190    END SUBROUTINE Agrif_InitValues_cont 
    191  
    192  
    193    SUBROUTINE agrif_declare_var 
    194       !!---------------------------------------------------------------------- 
    195       !!                 *** ROUTINE agrif_declarE_var *** 
    196       !! 
    197       !! ** Purpose :: Declaration of variables to be interpolated 
    198       !!---------------------------------------------------------------------- 
    199       USE agrif_util 
    200       USE par_oce       !   ONLY : jpts 
    201       USE oce 
    202       IMPLICIT NONE 
    203       !!---------------------------------------------------------------------- 
    204     
    205       ! 1. Declaration of the type of variable which have to be interpolated 
    206       !--------------------------------------------------------------------- 
    207       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    208       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
    209       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
    210  
    211       CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    212       CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    213       CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
    214       CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
    215     
    216       CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    217       CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    218  
    219       CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    220       CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
    221         
    222       ! 2. Type of interpolation 
    223       !------------------------- 
    224       CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    225       CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    226     
    227       Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    228       Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    229  
    230       Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    231       Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    232  
    233       Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    234       Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    235  
    236       ! 3. Location of interpolation 
    237       !----------------------------- 
    238       Call Agrif_Set_bc(un_id,(/0,1/)) 
    239       Call Agrif_Set_bc(vn_id,(/0,1/)) 
    240  
    241       Call Agrif_Set_bc(e1u_id,(/0,0/)) 
    242       Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    243  
    244       Call Agrif_Set_bc(tsn_id,(/0,1/)) 
    245       Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    246  
    247       Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    248       Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
    249  
    250       ! 5. Update type 
    251       !---------------  
    252       Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    253       Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    254  
    255       Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    256       Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
    257  
    258       Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    259       Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    260  
    261       Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    262       Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    263  
    264    END SUBROUTINE agrif_declare_var 
     511#  endif          
     512      ! Check passive tracer cell 
     513      IF( nn_dttrc .ne. 1 ) THEN 
     514         WRITE(*,*) 'nn_dttrc should be equal to 1' 
     515      ENDIF 
     516   ENDIF 
     517 
     518!ch   CALL Agrif_Update_trc(0) 
     519   nbcline_trc = 0 
     520   ! 
     521   DEALLOCATE(tabtrtemp) 
     522   ! 
     523END SUBROUTINE Agrif_InitValues_cont_top 
     524 
     525 
     526SUBROUTINE agrif_declare_var_top 
     527   !!---------------------------------------------------------------------- 
     528   !!                 *** ROUTINE agrif_declare_var_top *** 
     529   !! 
     530   !! ** Purpose :: Declaration of TOP variables to be interpolated 
     531   !!---------------------------------------------------------------------- 
     532   USE agrif_util 
     533   USE dom_oce 
     534   USE trc 
     535 
     536   IMPLICIT NONE 
     537 
     538   ! 1. Declaration of the type of variable which have to be interpolated 
     539   !--------------------------------------------------------------------- 
     540   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     541   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     542   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
     543 
     544   ! 2. Type of interpolation 
     545   !------------------------- 
     546   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
     547   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
     548 
     549   ! 3. Location of interpolation 
     550   !----------------------------- 
     551   Call Agrif_Set_bc(trn_id,(/0,1/)) 
     552   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
     553 
     554   ! 5. Update type 
     555   !---------------  
     556   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     557   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
     558 
     559 
     560END SUBROUTINE agrif_declare_var_top 
    265561# endif 
    266     
    267 # if defined key_top 
    268    SUBROUTINE Agrif_InitValues_cont_top 
    269       !!---------------------------------------------------------------------- 
    270       !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
    271       !! 
    272       !! ** Purpose :: Declaration of variables to be interpolated 
    273       !!---------------------------------------------------------------------- 
    274       USE Agrif_Util 
    275       USE oce  
    276       USE dom_oce 
    277       USE nemogcm 
    278       USE trc 
    279       USE in_out_manager 
    280       USE agrif_top_update 
    281       USE agrif_top_interp 
    282       USE agrif_top_sponge 
    283       ! 
    284       IMPLICIT NONE 
    285       ! 
    286       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
    287       LOGICAL :: check_namelist 
    288       !!---------------------------------------------------------------------- 
    289  
    290       ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
    291        
    292        
    293       ! 1. Declaration of the type of variable which have to be interpolated 
    294       !--------------------------------------------------------------------- 
    295       CALL agrif_declare_var_top 
    296  
    297       ! 2. First interpolations of potentially non zero fields 
    298       !------------------------------------------------------- 
    299       Agrif_SpecialValue=0. 
    300       Agrif_UseSpecialValue = .TRUE. 
    301       Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.) 
    302       Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
    303       Agrif_UseSpecialValue = .FALSE. 
    304  
    305       ! 3. Some controls 
    306       !----------------- 
    307       check_namelist = .true. 
    308              
    309       IF( check_namelist ) THEN 
    310 #  if defined offline      
    311          ! Check time steps 
    312          IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    313             WRITE(*,*) 'incompatible time step between grids' 
    314             WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    315             WRITE(*,*) 'child  grid value : ',nint(rdt) 
    316             WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    317             STOP 
    318          ENDIF 
    319  
    320          ! Check run length 
    321          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    322             Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    323             WRITE(*,*) 'incompatible run length between grids' 
    324             WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    325                Agrif_Parent(nit000)+1),' time step' 
    326             WRITE(*,*) 'child  grid value : ', & 
    327                (nitend-nit000+1),' time step' 
    328             WRITE(*,*) 'value on child grid should be : ', & 
    329                Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    330                Agrif_Parent(nit000)+1) 
    331             STOP 
    332          ENDIF 
    333           
    334          ! Check coordinates 
    335          IF( ln_zps ) THEN 
    336             ! check parameters for partial steps  
    337             IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
    338                WRITE(*,*) 'incompatible e3zps_min between grids' 
    339                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    340                WRITE(*,*) 'child grid  :',e3zps_min 
    341                WRITE(*,*) 'those values should be identical' 
    342                STOP 
    343             ENDIF           
    344             IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
    345                WRITE(*,*) 'incompatible e3zps_rat between grids' 
    346                WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    347                WRITE(*,*) 'child grid  :',e3zps_rat 
    348                WRITE(*,*) 'those values should be identical'                   
    349                STOP 
    350             ENDIF 
    351          ENDIF 
    352 #  endif          
    353         ! Check passive tracer cell 
    354         IF( nn_dttrc .ne. 1 ) THEN 
    355            WRITE(*,*) 'nn_dttrc should be equal to 1' 
    356         ENDIF 
    357       ENDIF 
    358         
    359       CALL Agrif_Update_trc(0) 
    360       nbcline_trc = 0 
    361       ! 
    362       DEALLOCATE(tabtrtemp) 
    363       ! 
    364    END SUBROUTINE Agrif_InitValues_cont_top 
    365  
    366  
    367    SUBROUTINE agrif_declare_var_top 
    368       !!---------------------------------------------------------------------- 
    369       !!                 *** ROUTINE agrif_declare_var_top *** 
    370       !! 
    371       !! ** Purpose :: Declaration of TOP variables to be interpolated 
    372       !!---------------------------------------------------------------------- 
    373       USE agrif_util 
    374       USE dom_oce 
    375       USE trc 
    376        
    377       IMPLICIT NONE 
    378     
    379       ! 1. Declaration of the type of variable which have to be interpolated 
    380       !--------------------------------------------------------------------- 
    381       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    382       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    383       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
    384 #  if defined key_offline 
    385       CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    386       CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    387 #  endif 
    388         
    389       ! 2. Type of interpolation 
    390       !------------------------- 
    391       CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
    392       CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
    393     
    394 #  if defined key_offline 
    395       Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    396       Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    397 #  endif 
    398  
    399       ! 3. Location of interpolation 
    400       !----------------------------- 
    401 #  if defined key_offline 
    402       Call Agrif_Set_bc(e1u_id,(/0,0/)) 
    403       Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    404 #  endif 
    405       Call Agrif_Set_bc(trn_id,(/0,1/)) 
    406       Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
    407  
    408       ! 5. Update type 
    409       !---------------  
    410       Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    411       Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
    412  
    413 #  if defined key_offline 
    414       Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    415       Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    416 #  endif 
    417  
    418    END SUBROUTINE agrif_declare_var_top 
     562 
     563SUBROUTINE Agrif_detect( kg, ksizex ) 
     564   !!---------------------------------------------------------------------- 
     565   !!   *** ROUTINE Agrif_detect *** 
     566   !!---------------------------------------------------------------------- 
     567   USE Agrif_Types 
     568   ! 
     569   INTEGER, DIMENSION(2) :: ksizex 
     570   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
     571   !!---------------------------------------------------------------------- 
     572   ! 
     573   RETURN 
     574   ! 
     575END SUBROUTINE Agrif_detect 
     576 
     577 
     578SUBROUTINE agrif_nemo_init 
     579   !!---------------------------------------------------------------------- 
     580   !!                     *** ROUTINE agrif_init *** 
     581   !!---------------------------------------------------------------------- 
     582   USE agrif_oce  
     583   USE agrif_ice 
     584   USE in_out_manager 
     585   USE lib_mpp 
     586   IMPLICIT NONE 
     587   ! 
     588   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
     589   !!---------------------------------------------------------------------- 
     590   ! 
     591   REWIND( numnam )                ! Read namagrif namelist 
     592   READ  ( numnam, namagrif ) 
     593   ! 
     594   IF(lwp) THEN                    ! control print 
     595      WRITE(numout,*) 
     596      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
     597      WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     598      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
     599      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update 
     600      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
     601      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
     602      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     603      WRITE(numout,*)  
     604   ENDIF 
     605   ! 
     606   ! convert DOCTOR namelist name into OLD names 
     607   nbclineupdate = nn_cln_update 
     608   visc_tra      = rn_sponge_tra 
     609   visc_dyn      = rn_sponge_dyn 
     610   ! 
     611   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     612# if defined key_lim2 
     613   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') 
    419614# endif 
    420     
    421    SUBROUTINE Agrif_detect( kg, ksizex ) 
    422       !!---------------------------------------------------------------------- 
    423       !!   *** ROUTINE Agrif_detect *** 
    424       !!---------------------------------------------------------------------- 
    425       USE Agrif_Types 
    426       ! 
    427       INTEGER, DIMENSION(2) :: ksizex 
    428       INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    429       !!---------------------------------------------------------------------- 
    430       ! 
    431       RETURN 
    432       ! 
    433    END SUBROUTINE Agrif_detect 
    434  
    435  
    436    SUBROUTINE agrif_nemo_init 
    437       !!---------------------------------------------------------------------- 
    438       !!                     *** ROUTINE agrif_init *** 
    439       !!---------------------------------------------------------------------- 
    440       USE agrif_oce  
    441       USE in_out_manager 
    442       USE lib_mpp 
    443       IMPLICIT NONE 
    444       ! 
    445       NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    446       !!---------------------------------------------------------------------- 
    447       ! 
    448       REWIND( numnam )                ! Read namagrif namelist 
    449       READ  ( numnam, namagrif ) 
    450       ! 
    451       IF(lwp) THEN                    ! control print 
    452          WRITE(numout,*) 
    453          WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
    454          WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    455          WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    456          WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update 
    457          WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
    458          WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    459          WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    460          WRITE(numout,*)  
    461       ENDIF 
    462       ! 
    463       ! convert DOCTOR namelist name into OLD names 
    464       nbclineupdate = nn_cln_update 
    465       visc_tra      = rn_sponge_tra 
    466       visc_dyn      = rn_sponge_dyn 
    467       ! 
    468       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
    469       ! 
    470     END SUBROUTINE agrif_nemo_init 
     615   ! 
     616END SUBROUTINE agrif_nemo_init 
    471617 
    472618# if defined key_mpp_mpi 
    473619 
    474    SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    475       !!---------------------------------------------------------------------- 
    476       !!                     *** ROUTINE Agrif_detect *** 
    477       !!---------------------------------------------------------------------- 
    478       USE dom_oce 
    479       IMPLICIT NONE 
    480       ! 
    481       INTEGER :: indglob, indloc, nprocloc, i 
    482       !!---------------------------------------------------------------------- 
    483       ! 
    484       SELECT CASE( i ) 
    485       CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    486       CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
    487       CASE(3)   ;   indglob = indloc 
    488       CASE(4)   ;   indglob = indloc 
    489       END SELECT 
    490       ! 
    491    END SUBROUTINE Agrif_InvLoc 
     620SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
     621   !!---------------------------------------------------------------------- 
     622   !!                     *** ROUTINE Agrif_detect *** 
     623   !!---------------------------------------------------------------------- 
     624   USE dom_oce 
     625   IMPLICIT NONE 
     626   ! 
     627   INTEGER :: indglob, indloc, nprocloc, i 
     628   !!---------------------------------------------------------------------- 
     629   ! 
     630   SELECT CASE( i ) 
     631   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
     632   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
     633   CASE(3)   ;   indglob = indloc 
     634   CASE(4)   ;   indglob = indloc 
     635   END SELECT 
     636   ! 
     637END SUBROUTINE Agrif_InvLoc 
    492638 
    493639# endif 
    494640 
    495641#else 
    496    SUBROUTINE Subcalledbyagrif 
    497       !!---------------------------------------------------------------------- 
    498       !!                   *** ROUTINE Subcalledbyagrif *** 
    499       !!---------------------------------------------------------------------- 
    500       WRITE(*,*) 'Impossible to be here' 
    501    END SUBROUTINE Subcalledbyagrif 
     642SUBROUTINE Subcalledbyagrif 
     643   !!---------------------------------------------------------------------- 
     644   !!                   *** ROUTINE Subcalledbyagrif *** 
     645   !!---------------------------------------------------------------------- 
     646   WRITE(*,*) 'Impossible to be here' 
     647END SUBROUTINE Subcalledbyagrif 
    502648#endif 
Note: See TracChangeset for help on using the changeset viewer.