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

Changeset 3566


Ignore:
Timestamp:
2012-11-15T19:09:49+01:00 (11 years ago)
Author:
cetlod
Message:

branch dev_r3387_LOCEAN6_AGRIF_LIM: add some corrections to make AGRIF compatible with TOP

Location:
branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r3294 r3566  
    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_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r3294 r3566  
    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_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r3294 r3566  
    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_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r3294 r3566  
    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_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r3454 r3566  
    434434   USE dom_oce 
    435435   USE nemogcm 
     436   USE par_trc 
    436437   USE trc 
    437438   USE in_out_manager 
     
    457458   Agrif_SpecialValue=0. 
    458459   Agrif_UseSpecialValue = .TRUE. 
    459    Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.) 
     460   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 
    460461   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
    461462   Agrif_UseSpecialValue = .FALSE. 
     
    515516   ENDIF 
    516517 
    517    CALL Agrif_Update_trc(0) 
     518!ch   CALL Agrif_Update_trc(0) 
    518519   nbcline_trc = 0 
    519520   ! 
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r3332 r3566  
    3030   PUBLIC prt_ctl_info    ! called by all subroutines 
    3131   PUBLIC prt_ctl_init    ! called by opa.F90 
     32   PUBLIC sub_dom         ! called by opa.F90 
    3233 
    3334   !!---------------------------------------------------------------------- 
     
    419420         nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    420421 
    421       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
     422      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    422423      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    423424      !!---------------------------------------------------------------------- 
    424425 
     426      ! 
     427      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
     428      ! 
    425429      !  1. Dimension arrays for subdomains 
    426430      ! ----------------------------------- 
     
    438442#endif 
    439443 
    440       ALLOCATE(ilcitl (isplt,jsplt)) 
    441       ALLOCATE(ilcjtl (isplt,jsplt)) 
    442444 
    443445      nrecil  = 2 * jpreci 
     
    512514      ! ------------------------------- 
    513515 
    514       ALLOCATE(iimpptl(isplt,jsplt)) 
    515       ALLOCATE(ijmpptl(isplt,jsplt)) 
    516        
    517516      iimpptl(:,:) = 1 
    518517      ijmpptl(:,:) = 1 
     
    572571      END DO 
    573572      ! 
    574       DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 
     573      ! 
     574      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
     575      ! 
    575576      ! 
    576577   END SUBROUTINE sub_dom 
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3454 r3566  
    118118      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    119119      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     120# if defined key_top 
     121      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
     122# endif 
    120123# if defined key_lim2 
    121124      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
    122 # endif 
    123 # if defined key_top 
    124       CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    125125# endif 
    126126#endif 
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r3294 r3566  
    3434   USE tranxt 
    3535# if defined key_agrif 
    36    USE agrif_top_update 
    3736   USE agrif_top_interp 
    3837# endif 
     
    146145      ENDIF 
    147146 
    148 #if defined key_agrif 
    149       ! Update tracer at AGRIF zoom boundaries 
    150       IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only 
    151 #endif       
    152  
    153147      ! trends computation 
    154148      IF( l_trdtrc ) THEN                                      ! trends 
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r3294 r3566  
    2929 
    3030#if defined key_agrif 
    31    USE agrif_top_sponge ! Momemtum and tracers sponges 
     31   USE agrif_top_sponge ! tracers sponges 
     32   USE agrif_top_update ! tracers updates 
    3233#endif 
    3334 
     
    7677                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
    7778         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     79 
     80#if defined key_agrif 
     81      IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )   ! Update tracer at AGRIF zoom boundaries : children only 
     82#endif 
    7883         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive 
    7984                                                                ! tracers at the bottom ocean level 
     
    98103   !!---------------------------------------------------------------------- 
    99104CONTAINS 
    100    SUBROUTINE trc_trp( kt )              ! Empty routine 
    101       INTEGER, INTENT(in) ::   kt 
    102       WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 
     105   SUBROUTINE trc_trp( kstp )              ! Empty routine 
     106      INTEGER, INTENT(in) ::   kstp 
     107      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp 
    103108   END SUBROUTINE trc_trp 
    104109#endif 
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r3294 r3566  
    5656 
    5757   !* model domain * 
    58    USE dom_oce , ONLY :   lzoom      => lzoom        !: zoom flag 
    59    USE dom_oce , ONLY :   lzoom_e    => lzoom_e      !: East  zoom type flag 
    60    USE dom_oce , ONLY :   lzoom_w    => lzoom_w      !: West  zoom type flag 
    61    USE dom_oce , ONLY :   lzoom_s    => lzoom_s      !: South zoom type flag 
    62    USE dom_oce , ONLY :   lzoom_n    => lzoom_n      !: North zoom type flag 
    63    USE dom_oce , ONLY :   lzoom_arct => lzoom_arct   !: ORCA    arctic zoom flag 
    64    USE dom_oce , ONLY :   lzoom_anta => lzoom_anta   !: ORCA antarctic zoom flag 
    65    USE dom_oce , ONLY :   nperio     =>   nperio     !: type of lateral boundary condition        
    66    USE dom_oce , ONLY :   nimpp      =>   nimpp      !: i index for mpp-subdomain left bottom 
    67    USE dom_oce , ONLY :   njmpp      =>   njmpp      !: j index for mpp-subdomain left bottom 
    68    USE dom_oce , ONLY :   nproc      =>   nproc      !: number for local processor 
    69    USE dom_oce , ONLY :   narea      =>   narea      !: number for local area 
    70    USE dom_oce , ONLY :   mig        =>   mig        !: local  ==> global  domain i-indice 
    71    USE dom_oce , ONLY :   mjg        =>   mjg        !: local  ==> global  domain i-indice 
    72    USE dom_oce , ONLY :   mi0        =>   mi0        !: global ==> local domain i-indice  
    73    USE dom_oce , ONLY :   mi1        =>   mi1        !: (mi0=1 and mi1=0 if the global indice is not in the local one) 
    74    USE dom_oce , ONLY :   mj0        =>   mj0        !: global ==> local domain j-indice  
    75    USE dom_oce , ONLY :   mj1        =>   mj1        !: (mj0=1 and mj1=0 if the global indice is not in the local one) 
    76    USE dom_oce , ONLY :   nidom      =>   nidom 
    77    USE dom_oce , ONLY :   nimppt     => nimppt     !:i-indexes for each processor 
    78    USE dom_oce , ONLY :   njmppt     => njmppt       !:j-indexes for each processor 
    79    USE dom_oce , ONLY :   ibonit     => ibonit       !:i-processor neighbour existence 
    80    USE dom_oce , ONLY :   ibonjt     => ibonjt       !:j- processor neighbour existence  
    81    USE dom_oce , ONLY :   nlci       => nlci         !:i- & j-dimensions of the local subdomain 
    82    USE dom_oce , ONLY :   nlcj       => nlcj         !: 
    83    USE dom_oce , ONLY :   nldi       => nldi         !:first and last indoor i- and j-indexes 
    84    USE dom_oce , ONLY :   nlei       => nlei         !: 
    85    USE dom_oce , ONLY :   nldj       => nldj         !: 
    86    USE dom_oce , ONLY :   nlej       => nlej         !: 
    87    USE dom_oce , ONLY :   nlcit      => nlcit        !:dimensions of every i-subdomain 
    88    USE dom_oce , ONLY :   nlcjt      => nlcjt        !:dimensions of every j-subdomain 
    89    USE dom_oce , ONLY :   nldit      => nldit        !:first indoor index for each i-domain  
    90    USE dom_oce , ONLY :   nleit      => nleit        !:last indoor index for each i-domain  
    91    USE dom_oce , ONLY :   nldjt      => nldjt        !:first indoor index for each j-domain  
    92    USE dom_oce , ONLY :   nlejt      => nlejt        !:last indoor index for each j-domain  
    93   
    94    !* horizontal mesh * 
    95    USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)   
    96    USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)   
    97    USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)   
    98    USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)   
    99    USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)    
    100    USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)    
    101    USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)    
    102    USE dom_oce , ONLY :   gphif      =>   gphif      !: latitude  of t-point (degre)    
    103    USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)   
    104    USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)    
    105    USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2) 
    106    USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m) 
    107    USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m) 
    108    USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m) 
    109    USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)   
    110  
    111    !* vertical mesh * 
    112    USE dom_oce , ONLY :   gdept_0    =>   gdept_0    !: reference depth of t-points (m) 
    113    USE dom_oce , ONLY :   e3t_0      =>   e3t_0      !: reference depth of t-points (m)   
    114    USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m) 
    115    USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m) 
    116 # if ! defined key_zco 
    117    USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ??? 
    118    USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m) 
    119    USE dom_oce , ONLY :   gdepw      =>  gdepw       !: depth of t-points (m) 
    120    USE dom_oce , ONLY :   e3t        =>  e3t         !: vertical scale factors at t- 
    121    USE dom_oce , ONLY :   e3u        =>  e3u         !: vertical scale factors at u- 
    122    USE dom_oce , ONLY :   e3v        =>  e3v         !: vertical scale factors v- 
    123    USE dom_oce , ONLY :   e3w        =>  e3w         !: w-points (m) 
    124    USE dom_oce , ONLY :   e3f        =>  e3f         !: f-points (m) 
    125    USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m) 
    126    USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m) 
    127 # endif 
    128    USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag 
    129    USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag 
    130    USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag 
    131    USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m) 
    132    USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m) 
    133    USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m) 
    134    USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels 
    135    USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels 
    136    USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w) 
    137    USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels 
    138    USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels 
    139    USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag 
    140 # if defined key_vvl 
    141    USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ??? 
    142    USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m) 
    143    USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m) 
    144    USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t- 
    145    USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u- 
    146    USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v- 
    147    USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m) 
    148    USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m) 
    149    USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m) 
    150    USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m) 
    151 # endif 
    152    !* masks, bathymetry * 
    153    USE dom_oce , ONLY :   mbkt       =>   mbkt       !: vertical index of the bottom last T- ocean level 
    154    USE dom_oce , ONLY :   mbku       =>   mbku       !: vertical index of the bottom last U- ocean level 
    155    USE dom_oce , ONLY :   mbkv       =>   mbkv       !: vertical index of the bottom last V- ocean level 
    156    USE dom_oce , ONLY :   tmask_i    =>   tmask_i    !: Interior mask at t-points 
    157    USE dom_oce , ONLY :   tmask      =>   tmask      !: land/ocean mask at t-points 
    158    USE dom_oce , ONLY :   umask      =>   umask      !: land/ocean mask at u-points    
    159    USE dom_oce , ONLY :   vmask      =>   vmask      !: land/ocean mask at v-points  
    160    USE dom_oce , ONLY :   fmask      =>   fmask      !: land/ocean mask at f-points  
    161  
    162    !* time domain * 
    163    USE dom_oce , ONLY :   neuler     =>   neuler     !: restart euler forward option (0=Euler) 
    164    USE dom_oce , ONLY :   rdt        =>   rdt        !: time step for the dynamics  
    165    USE dom_oce , ONLY :   atfp       =>   atfp       !: asselin time filter parameter 
    166    USE dom_oce , ONLY :   atfp1      =>   atfp1      !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    167    USE dom_oce , ONLY :   rdttra     =>   rdttra     !: vertical profile of tracer time step 
    168    !                                                 !: it is the accumulated duration of previous runs 
    169    !                                                 !: that may have been run with different time steps. 
    170    !* calendar variables * 
    171    USE dom_oce , ONLY :   nyear      =>   nyear      !: current year 
    172    USE dom_oce , ONLY :   nmonth     =>   nmonth     !: current month 
    173    USE dom_oce , ONLY :   nday       =>   nday       !: current day of the month 
    174    USE dom_oce , ONLY :   ndastp     =>   ndastp     !: time step date in yyyymmdd format 
    175    USE dom_oce , ONLY :   nday_year  =>   nday_year  !: current day counted from jan 1st of the current year 
    176    USE dom_oce , ONLY :   nsec_year  =>   nsec_year  !: current time step counted in second since 00h jan 1st of the current year 
    177    USE dom_oce , ONLY :   nsec_month =>   nsec_month !: current time step counted in second since 00h 1st day of the current month 
    178    USE dom_oce , ONLY :   nsec_day   =>   nsec_day   !: current time step counted in second since 00h of the current day 
    179    USE dom_oce , ONLY :   fjulday    =>   fjulday    !: julian day 
    180    USE dom_oce , ONLY :   adatrj     =>   adatrj     !: number of elapsed days since the begining of the whole simulation 
    181                                                      !: (cumulative duration of previous runs  
    182                                                      !: that may have used different time-step size) 
    183    USE dom_oce , ONLY :   nyear_len  =>   nyear_len  !: length in days of the previous/current year 
    184    USE dom_oce , ONLY :   nmonth_len =>   nmonth_len !: length in days of the months of the current year 
     58   USE dom_oce  
    18559 
    18660 
     
    21791   USE oce , ONLY :   grv     =>    grv     !:  
    21892#endif 
    219  
    220    USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection  
    22193 
    22294   !* surface fluxes * 
  • branches/2012/dev_r3387_LOCEAN6_AGRIF_LIM/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

    r3294 r3566  
    1717   USE par_trc          ! TOP parameters 
    1818   USE oce_trc          ! ocean space and time domain variables 
     19   USE prtctl           ! print control for OPA 
    1920 
    2021   IMPLICIT NONE 
     
    296297   END SUBROUTINE prt_ctl_trc_init 
    297298 
    298  
    299    SUBROUTINE sub_dom 
    300       !!---------------------------------------------------------------------- 
    301       !!                  ***  ROUTINE sub_dom  *** 
    302       !!                     
    303       !! ** Purpose :   Lay out the global domain over processors.  
    304       !!                CAUTION:  
    305       !!                This part has been extracted from the mpp_init 
    306       !!                subroutine and names of variables/arrays have been  
    307       !!                slightly changed to avoid confusion but the computation 
    308       !!                is exactly the same. Any modification about indices of 
    309       !!                each sub-domain in the mppini.F90 module should be reported  
    310       !!                here. 
    311       !! 
    312       !! ** Method  :   Global domain is distributed in smaller local domains. 
    313       !!                Periodic condition is a function of the local domain position 
    314       !!                (global boundary or neighbouring domain) and of the global 
    315       !!                periodic 
    316       !!                Type :         jperio global periodic condition 
    317       !!                               nperio local  periodic condition 
    318       !! 
    319       !! ** Action  : - set domain parameters 
    320       !!                    nimpp     : longitudinal index  
    321       !!                    njmpp     : latitudinal  index 
    322       !!                    nperio    : lateral condition type  
    323       !!                    narea     : number for local area 
    324       !!                    nlcil      : first dimension 
    325       !!                    nlcjl      : second dimension 
    326       !!                    nbondil    : mark for "east-west local boundary" 
    327       !!                    nbondjl    : mark for "north-south local boundary" 
    328       !!---------------------------------------------------------------------- 
    329       INTEGER ::   ji, jj, js               ! dummy loop indices 
    330       INTEGER ::   ii, ij                   ! temporary integers 
    331       INTEGER ::   irestil, irestjl         !    "          " 
    332       INTEGER ::   ijpi  , ijpj, nlcil      ! temporary logical unit 
    333       INTEGER ::   nlcjl , nbondil, nbondjl 
    334       INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    335       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    336       INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace 
    337       !!---------------------------------------------------------------------- 
    338       ! 
    339       CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
    340       ! 
    341       ! Dimension arrays for subdomains 
    342       ! ------------------------------- 
    343       !  Computation of local domain sizes ilcitl() ilcjtl() 
    344       !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    345       !  The subdomains are squares leeser than or equal to the global 
    346       !  dimensions divided by the number of processors minus the overlap 
    347       !  array (cf. par_oce.F90). 
    348  
    349       ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
    350       ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
    351  
    352       nrecil  = 2 * jpreci 
    353       nrecjl  = 2 * jprecj 
    354       irestil = MOD( jpiglo - nrecil , isplt ) 
    355       irestjl = MOD( jpjglo - nrecjl , jsplt ) 
    356  
    357       IF(  irestil == 0 )   irestil = isplt 
    358       DO jj = 1, jsplt 
    359          DO ji = 1, irestil 
    360             ilcitl(ji,jj) = ijpi 
    361          END DO 
    362          DO ji = irestil+1, isplt 
    363             ilcitl(ji,jj) = ijpi -1 
    364          END DO 
    365       END DO 
    366        
    367       IF( irestjl == 0 )   irestjl = jsplt 
    368       DO ji = 1, isplt 
    369          DO jj = 1, irestjl 
    370             ilcjtl(ji,jj) = ijpj 
    371          END DO 
    372          DO jj = irestjl+1, jsplt 
    373             ilcjtl(ji,jj) = ijpj -1 
    374          END DO 
    375       END DO 
    376        
    377       zidom = nrecil 
    378       DO ji = 1, isplt 
    379          zidom = zidom + ilcitl(ji,1) - nrecil 
    380       END DO 
    381        
    382       zjdom = nrecjl 
    383       DO jj = 1, jsplt 
    384          zjdom = zjdom + ilcjtl(1,jj) - nrecjl 
    385       END DO 
    386  
    387       ! Index arrays for subdomains 
    388       ! --------------------------- 
    389  
    390       iimpptl(:,:) = 1 
    391       ijmpptl(:,:) = 1 
    392        
    393       IF( isplt > 1 ) THEN 
    394          DO jj = 1, jsplt 
    395             DO ji = 2, isplt 
    396                iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil 
    397             END DO 
    398          END DO 
    399       ENDIF 
    400  
    401       IF( jsplt > 1 ) THEN 
    402          DO jj = 2, jsplt 
    403             DO ji = 1, isplt 
    404                ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl 
    405             END DO 
    406          END DO 
    407       ENDIF 
    408        
    409       ! Subdomain description 
    410       ! --------------------- 
    411  
    412       DO js = 1, ijsplt 
    413          ii = 1 + MOD( js-1, isplt ) 
    414          ij = 1 + (js-1) / isplt 
    415          nimpptl(js) = iimpptl(ii,ij) 
    416          njmpptl(js) = ijmpptl(ii,ij) 
    417          nlcitl (js) = ilcitl (ii,ij)      
    418          nlcil       = nlcitl (js)      
    419          nlcjtl (js) = ilcjtl (ii,ij)      
    420          nlcjl       = nlcjtl (js) 
    421          nbondjl = -1                                    ! general case 
    422          IF( js   >  isplt          )   nbondjl = 0      ! first row of processor 
    423          IF( js   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor 
    424          IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction 
    425          ibonjtl(js) = nbondjl 
    426           
    427          nbondil = 0                                     !  
    428          IF( MOD( js, isplt ) == 1 )   nbondil = -1      ! 
    429          IF( MOD( js, isplt ) == 0 )   nbondil =  1      ! 
    430          IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction 
    431          ibonitl(js) = nbondil 
    432           
    433          nldil =  1   + jpreci 
    434          nleil = nlcil - jpreci 
    435          IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1 
    436          IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil 
    437          nldjl =  1   + jprecj 
    438          nlejl = nlcjl - jprecj 
    439          IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1 
    440          IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl 
    441          nlditl(js) = nldil 
    442          nleitl(js) = nleil 
    443          nldjtl(js) = nldjl 
    444          nlejtl(js) = nlejl 
    445       END DO 
    446       ! 
    447       CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
    448       ! 
    449    END SUBROUTINE sub_dom 
    450   
    451299#else 
    452300   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.