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
RevLine 
[1271]1#define SPONGE_TOP
2
[5656]3MODULE agrif_top_sponge
[6140]4   !!======================================================================
5   !!                ***  MODULE agrif_top_sponge  ***
[7953]6   !! AGRIF :   TOP sponge layer
[6140]7   !!======================================================================
8   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
9   !!----------------------------------------------------------------------
[7953]10#if defined key_agrif && defined key_top
[6140]11   !!----------------------------------------------------------------------
12   !!   Agrif_Sponge_trc :
13   !!   interptrn_sponge : 
14   !!----------------------------------------------------------------------
[1271]15   USE par_oce
[5656]16   USE par_trc
[1271]17   USE oce
[6140]18   USE trc
[1271]19   USE dom_oce
20   USE agrif_oce
[3680]21   USE agrif_opa_sponge
[6140]22   !
23   USE in_out_manager
[2715]24   USE lib_mpp
[3294]25   USE wrk_nemo 
[1271]26
27   IMPLICIT NONE
28   PRIVATE
29
[5656]30   PUBLIC Agrif_Sponge_trc, interptrn_sponge
[1271]31
32   !!----------------------------------------------------------------------
[7953]33   !! NEMO/NST 4.0 , NEMO Consortium (2017)
[2528]34   !! $Id$
35   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1271]36   !!----------------------------------------------------------------------
[5656]37CONTAINS
[1271]38
[5656]39   SUBROUTINE Agrif_Sponge_trc
[6140]40      !!----------------------------------------------------------------------
41      !!                   *** ROUTINE Agrif_Sponge_Trc ***
42      !!----------------------------------------------------------------------
[7953]43      REAL(wp) ::   timecoeff   ! local scalar
[6140]44      !!----------------------------------------------------------------------
45      !
[1271]46#if defined SPONGE_TOP
[6140]47      timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot()
[5656]48      CALL Agrif_sponge
[6140]49      Agrif_SpecialValue    = 0._wp
[1271]50      Agrif_UseSpecialValue = .TRUE.
[6140]51      tabspongedone_trn     = .FALSE.
52      CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge )
[1271]53      Agrif_UseSpecialValue = .FALSE.
54#endif
[6140]55      !
[1271]56   END SUBROUTINE Agrif_Sponge_Trc
57
[5656]58
[6140]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      !
[5656]67      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
[6140]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      !!----------------------------------------------------------------------
[3680]72      !
[6140]73      IF( before ) THEN
[5656]74         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
75      ELSE     
[6140]76!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected
[5656]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
[6140]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)
[5656]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) )
[6140]86                  END DO
87               END DO
88               !
[5656]89               DO jj = j1+1,j2-1
90                  DO ji = i1+1,i2-1
[6140]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)
[5656]95                     ENDIF
[6140]96                  END DO
97               END DO
98            END DO
99            !
100         END DO
101         !
[5656]102         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
103      ENDIF
104      !                 
105   END SUBROUTINE interptrn_sponge
106
[1271]107#else
[7953]108   !!----------------------------------------------------------------------
109   !!   Empty module                                           no TOP AGRIF
110   !!----------------------------------------------------------------------
[1271]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
[6140]117   !!======================================================================
[1271]118END MODULE agrif_top_sponge
Note: See TracBrowser for help on using the repository browser.