source: branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 @ 7953

Last change on this file since 7953 was 7953, checked in by gm, 4 years ago

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_…

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