source: trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 5 years ago

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.

  • Property svn:keywords set to Id
File size: 4.6 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      CALL Agrif_sponge
50      Agrif_SpecialValue    = 0._wp
51      Agrif_UseSpecialValue = .TRUE.
52      tabspongedone_trn     = .FALSE.
53      CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge )
54      Agrif_UseSpecialValue = .FALSE.
55#endif
56      !
57   END SUBROUTINE Agrif_Sponge_Trc
58
59
60   SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
61      !!----------------------------------------------------------------------
62      !!                   *** ROUTINE interptrn_sponge ***
63      !!----------------------------------------------------------------------
64      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
65      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   tabres
66      LOGICAL                                     , INTENT(in   ) ::   before
67      !
68      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
69      REAL(wp) ::   zabe1, zabe2
70      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv
71      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff
72      !!----------------------------------------------------------------------
73      !
74      IF( before ) THEN
75         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
76      ELSE     
77!!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected
78         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)     
79         DO jn = 1, jptra
80            DO jk = 1, jpkm1
81               DO jj = j1,j2-1
82                  DO ji = i1,i2-1
83                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk)
84                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
85                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
86                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
87                  END DO
88               END DO
89               !
90               DO jj = j1+1,j2-1
91                  DO ji = i1+1,i2-1
92                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN
93                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
94                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
95                           &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)
96                     ENDIF
97                  END DO
98               END DO
99            END DO
100            !
101         END DO
102         !
103         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
104      ENDIF
105      !                 
106   END SUBROUTINE interptrn_sponge
107
108#else
109
110CONTAINS
111   SUBROUTINE agrif_top_sponge_empty
112      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
113   END SUBROUTINE agrif_top_sponge_empty
114#endif
115
116   !!======================================================================
117END MODULE agrif_top_sponge
Note: See TracBrowser for help on using the repository browser.