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 6140 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90 – NEMO

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r5836 r6140  
    22 
    33MODULE agrif_opa_sponge 
     4   !!====================================================================== 
     5   !!                ***  MODULE agrif_opa_update  *** 
     6   !! AGRIF :    
     7   !!====================================================================== 
     8   !! History :   
     9   !!---------------------------------------------------------------------- 
    410#if defined key_agrif  && ! defined key_offline 
    511   USE par_oce 
     
    1723   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 
    1824 
    19    !! * Substitutions 
    20 #  include "domzgr_substitute.h90" 
    2125   !!---------------------------------------------------------------------- 
    22    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     26   !! NEMO/NST 3.7 , NEMO Consortium (2015) 
    2327   !! $Id$ 
    2428   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2529   !!---------------------------------------------------------------------- 
    26  
    2730CONTAINS 
    2831 
     
    3134      !!   *** ROUTINE Agrif_Sponge_Tra *** 
    3235      !!--------------------------------------------- 
    33       !! 
    3436      REAL(wp) :: timecoeff 
    35  
     37      !!--------------------------------------------- 
     38      ! 
    3639#if defined SPONGE 
    3740      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     
    4649      Agrif_UseSpecialValue = .FALSE. 
    4750#endif 
    48  
     51      ! 
    4952   END SUBROUTINE Agrif_Sponge_Tra 
    5053 
     54 
    5155   SUBROUTINE Agrif_Sponge_dyn 
    5256      !!--------------------------------------------- 
    5357      !!   *** ROUTINE Agrif_Sponge_dyn *** 
    5458      !!--------------------------------------------- 
    55       !! 
    5659      REAL(wp) :: timecoeff 
     60      !!--------------------------------------------- 
    5761 
    5862#if defined SPONGE 
     
    7276      Agrif_UseSpecialValue = .FALSE. 
    7377#endif 
    74  
     78      ! 
    7579   END SUBROUTINE Agrif_Sponge_dyn 
     80 
    7681 
    7782   SUBROUTINE Agrif_Sponge 
     
    183188      ! 
    184189#endif 
    185  
     190      ! 
    186191   END SUBROUTINE Agrif_Sponge 
     192 
    187193 
    188194   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
     
    193199      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    194200      LOGICAL, INTENT(in) :: before 
    195  
    196  
     201      ! 
    197202      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    198203      INTEGER  ::   iku, ikv 
     
    201206      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
    202207      ! 
    203       IF (before) THEN 
     208      IF( before ) THEN 
    204209         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
    205210      ELSE    
    206     
     211         ! 
    207212         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)     
    208213         DO jn = 1, jpts             
     
    210215               DO jj = j1,j2-1 
    211216                  DO ji = i1,i2-1 
    212                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    213                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     217                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     218                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    214219                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    215220                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    216                   ENDDO 
    217                ENDDO 
    218  
     221                  END DO 
     222               END DO 
     223               ! 
    219224               IF( ln_zps ) THEN      ! set gradient at partial step level 
    220225                  DO jj = j1,j2-1 
     
    223228                        iku = mbku(ji,jj) 
    224229                        ikv = mbkv(ji,jj) 
    225                         IF( iku == jk ) THEN 
    226                            ztu(ji,jj,jk) = 0._wp 
    227                         ENDIF 
    228                         IF( ikv == jk ) THEN 
    229                            ztv(ji,jj,jk) = 0._wp 
    230                         ENDIF 
     230                        IF( iku == jk )   ztu(ji,jj,jk) = 0._wp 
     231                        IF( ikv == jk )   ztv(ji,jj,jk) = 0._wp 
    231232                     END DO 
    232233                  END DO 
    233234               ENDIF 
    234             ENDDO 
    235  
     235            END DO 
     236            ! 
    236237            DO jk = 1, jpkm1 
    237238               DO jj = j1+1,j2-1 
    238239                  DO ji = i1+1,i2-1 
    239  
    240240                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
    241                         zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) 
     241                        zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    242242                        ! horizontal diffusive trends 
    243243                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) 
     
    245245                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
    246246                     ENDIF 
    247  
    248                   ENDDO 
    249                ENDDO 
    250  
    251             ENDDO 
    252          ENDDO 
    253  
     247                  END DO 
     248               END DO 
     249            END DO 
     250            ! 
     251         END DO 
     252         ! 
    254253         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
    255  
    256       ENDIF 
    257  
     254         ! 
     255      ENDIF 
     256      ! 
    258257   END SUBROUTINE interptsn_sponge 
     258 
    259259 
    260260   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 
     
    273273      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    274274      INTEGER :: jmax 
    275       ! 
    276  
    277  
    278       IF (before) THEN 
     275      !!---------------------------------------------     
     276      ! 
     277      IF( before ) THEN 
    279278         tabres = un(i1:i2,j1:j2,:) 
    280279      ELSE 
    281  
    282280         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 
    283  
     281         ! 
    284282         DO jk = 1, jpkm1                                 ! Horizontal slab 
    285283            !                                             ! =============== 
     
    290288            DO jj = j1,j2 
    291289               DO ji = i1+1,i2   ! vector opt. 
    292                   zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    293                   hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
    294                                      &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
     290                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     291                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
     292                                     &   -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
    295293               END DO 
    296294            END DO 
     
    298296            DO jj = j1,j2-1 
    299297               DO ji = i1,i2   ! vector opt. 
    300                   zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     298                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    301299                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 
    302300                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) &  
     
    304302               END DO 
    305303            END DO 
    306          ENDDO 
    307  
    308          ! 
    309  
    310  
    311  
     304         END DO 
     305         ! 
    312306         DO jj = j1+1, j2-1 
    313307            DO ji = i1+1, i2-1   ! vector opt. 
     
    318312                     ze1v = hdivdiff(ji,jj,jk) 
    319313                     ! horizontal diffusive trends 
    320                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   & 
     314                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   & 
    321315                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj) 
    322316 
     
    344338 
    345339                     ! horizontal diffusive trends 
    346                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   & 
     340                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
    347341                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj) 
    348342 
     
    351345                  END DO 
    352346               ENDIF 
    353  
    354             END DO 
    355          END DO 
    356  
    357  
     347               ! 
     348            END DO 
     349         END DO 
     350         ! 
    358351         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 
    359  
    360       ENDIF 
    361  
    362  
     352         ! 
     353      ENDIF 
     354      ! 
    363355   END SUBROUTINE interpun_sponge 
    364356 
     
    372364      LOGICAL, INTENT(in) :: before 
    373365      INTEGER, INTENT(in) :: nb , ndir 
    374  
    375       INTEGER :: ji,jj,jk 
    376  
    377       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    378  
     366      ! 
     367      INTEGER  ::   ji, jj, jk 
     368      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr 
    379369      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 
    380370      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
    381371      INTEGER :: imax 
    382       ! 
    383  
    384       IF (before) THEN  
     372      !!---------------------------------------------  
     373 
     374      IF( before ) THEN  
    385375         tabres = vn(i1:i2,j1:j2,:) 
    386376      ELSE 
    387  
     377         ! 
    388378         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 
    389  
     379         ! 
    390380         DO jk = 1, jpkm1                                 ! Horizontal slab 
    391381            !                                             ! =============== 
     
    396386            DO jj = j1+1,j2 
    397387               DO ji = i1,i2   ! vector opt. 
    398                   zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    399                   hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
    400                                      &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     388                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     389                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
     390                                     &  -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
    401391               END DO 
    402392            END DO 
    403393            DO jj = j1,j2 
    404394               DO ji = i1,i2-1   ! vector opt. 
    405                   zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     395                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    406396                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    407                                     &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) & 
    408                                     & ) * fmask(ji,jj,jk) * zbtr 
    409                END DO 
    410             END DO 
    411          ENDDO 
     397                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk)  ) * fmask(ji,jj,jk) * zbtr 
     398               END DO 
     399            END DO 
     400         END DO 
    412401 
    413402         !                                                ! =============== 
     
    415404 
    416405         imax = i2-1 
    417          IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 
     406         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3) 
    418407 
    419408         DO jj = j1+1, j2 
    420409            DO ji = i1+1, imax   ! vector opt. 
    421                IF (.NOT. tabspongedone_u(ji,jj)) THEN 
    422                   DO jk = 1, jpkm1                                 ! Horizontal slab 
    423                      ze2u = rotdiff (ji,jj,jk) 
    424                      ze1v = hdivdiff(ji,jj,jk) 
    425                      ! horizontal diffusive trends 
    426                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
    427                            / e1u(ji,jj) 
    428  
    429  
    430                      ! add it to the general momentum trends 
    431                      ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    432                   END DO 
    433  
    434                ENDIF 
    435             END DO 
    436          END DO 
    437  
     410               IF( .NOT. tabspongedone_u(ji,jj) ) THEN 
     411                  DO jk = 1, jpkm1 
     412                     ua(ji,jj,jk) = ua(ji,jj,jk)                                                               & 
     413                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )  & 
     414                        & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj) 
     415                  END DO 
     416               ENDIF 
     417            END DO 
     418         END DO 
     419         ! 
    438420         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 
    439  
     421         ! 
    440422         DO jj = j1+1, j2-1 
    441423            DO ji = i1+1, i2-1   ! vector opt. 
    442                IF (.NOT. tabspongedone_v(ji,jj)) THEN 
    443                   DO jk = 1, jpkm1                                 ! Horizontal slab 
    444                      ze2u = rotdiff (ji,jj,jk) 
    445                      ze1v = hdivdiff(ji,jj,jk) 
    446                      ! horizontal diffusive trends 
    447  
    448                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
    449                            / e2v(ji,jj) 
    450  
    451                      ! add it to the general momentum trends 
    452                      va(ji,jj,jk) = va(ji,jj,jk) + zva 
     424               IF( .NOT. tabspongedone_v(ji,jj) ) THEN 
     425                  DO jk = 1, jpkm1 
     426                     va(ji,jj,jk) = va(ji,jj,jk)                                                                  & 
     427                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
     428                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj) 
    453429                  END DO 
    454430               ENDIF 
     
    457433         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
    458434      ENDIF 
    459  
     435      ! 
    460436   END SUBROUTINE interpvn_sponge 
    461437 
    462438#else 
    463439CONTAINS 
    464  
    465440   SUBROUTINE agrif_opa_sponge_empty 
    466441      !!--------------------------------------------- 
     
    471446#endif 
    472447 
     448   !!====================================================================== 
    473449END MODULE agrif_opa_sponge 
Note: See TracChangeset for help on using the changeset viewer.