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.
agrif_top_sponge.F90 in branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 @ 8762

Last change on this file since 8762 was 8762, checked in by jchanut, 6 years ago

AGRIF + vvl: Final changes, update SETTE tests (these are ok except SAS) - #1965

  • Property svn:keywords set to Id
File size: 4.7 KB
Line 
1#define SPONGE_TOP
2
3MODULE agrif_top_sponge
4   !!======================================================================
5   !!                ***  MODULE agrif_top_sponge  ***
6   !! AGRIF :   define in memory AGRIF variables for sea-ice
7   !!======================================================================
8   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   Agrif_Sponge_trc :
13   !!   interptrn_sponge : 
14   !!----------------------------------------------------------------------
15#if defined key_agrif && defined key_top
16   USE par_oce
17   USE par_trc
18   USE oce
19   USE trc
20   USE dom_oce
21   USE agrif_oce
22   USE agrif_opa_sponge
23   !
24   USE in_out_manager
25   USE lib_mpp
26   USE wrk_nemo 
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC Agrif_Sponge_trc, interptrn_sponge
32
33   !!----------------------------------------------------------------------
34   !! NEMO/NST 3.7 , NEMO Consortium (2015)
35   !! $Id$
36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
38CONTAINS
39
40   SUBROUTINE Agrif_Sponge_trc
41      !!----------------------------------------------------------------------
42      !!                   *** ROUTINE Agrif_Sponge_Trc ***
43      !!----------------------------------------------------------------------
44      REAL(wp) ::   timecoeff
45      !!----------------------------------------------------------------------
46      !
47#if defined SPONGE_TOP
48!!      timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot()
49!! Assume persistence
50      timecoeff = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
51      CALL Agrif_sponge
52      Agrif_SpecialValue    = 0._wp
53      Agrif_UseSpecialValue = .TRUE.
54      tabspongedone_trn     = .FALSE.
55      CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge )
56      Agrif_UseSpecialValue = .FALSE.
57#endif
58      !
59   END SUBROUTINE Agrif_Sponge_Trc
60
61
62   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
63      !!----------------------------------------------------------------------
64      !!                   *** ROUTINE interptrn_sponge ***
65      !!----------------------------------------------------------------------
66      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
67      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
68      LOGICAL                                     , INTENT(in   ) ::   before
69      !
70      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
71      REAL(wp) ::   zabe1, zabe2
72      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv
73      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff
74      !!----------------------------------------------------------------------
75      !
76      IF( before ) THEN
77         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trb(i1:i2,j1:j2,k1:k2,n1:n2)
78      ELSE     
79!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected
80         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)     
81         DO jn = 1, jptra
82            DO jk = 1, jpkm1
83               DO jj = j1,j2-1
84                  DO ji = i1,i2-1
85                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
86                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
87                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
88                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
89                  END DO
90               END DO
91               !
92               DO jj = j1+1,j2-1
93                  DO ji = i1+1,i2-1
94                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN
95                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
96                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
97                           &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
98                     ENDIF
99                  END DO
100               END DO
101            END DO
102            !
103         END DO
104         !
105         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
106      ENDIF
107      !                 
108   END SUBROUTINE interptrn_sponge
109
110#else
111
112CONTAINS
113   SUBROUTINE agrif_top_sponge_empty
114      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
115   END SUBROUTINE agrif_top_sponge_empty
116#endif
117
118   !!======================================================================
119END MODULE agrif_top_sponge
Note: See TracBrowser for help on using the repository browser.