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/UKMO/r5518_INGV1_WAVE-coupling/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/UKMO/r5518_INGV1_WAVE-coupling/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 @ 7152

Last change on this file since 7152 was 7152, checked in by jcastill, 7 years ago

Initial implementation of wave coupling branch - INGV wave branch + UKMO wave coupling branch

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