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 trunk/NEMOGCM/NEMO/NST_SRC – NEMO

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

Last change on this file since 3319 was 3294, checked in by rblod, 12 years ago

Merge of 3.4beta into the trunk
  • Property svn:keywords set to Id
File size: 6.2 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 oce
7   USE dom_oce
8   USE in_out_manager
9   USE agrif_oce
10   USE trc
11   USE lib_mpp
12   USE wrk_nemo 
13
14   IMPLICIT NONE
15   PRIVATE
16
17   PUBLIC Agrif_Sponge_Trc, interptrn
18
19   !!----------------------------------------------------------------------
20   !! NEMO/NST 3.3 , NEMO Consortium (2010)
21   !! $Id$
22   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25   CONTAINS
26
27   SUBROUTINE Agrif_Sponge_Trc
28      !!---------------------------------------------
29      !!   *** ROUTINE Agrif_Sponge_Trc ***
30      !!---------------------------------------------
31#include "domzgr_substitute.h90"
32      !!
33      INTEGER :: ji,jj,jk,jl
34      INTEGER :: spongearea
35      REAL(wp) :: timecoeff
36      REAL(wp) :: ztra, zabe1, zabe2, zbtr
37      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
38      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab
39
40#if defined SPONGE_TOP
41      CALL wrk_alloc( jpi, jpj, localviscsponge )
42      CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
43
44      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
45
46      Agrif_SpecialValue=0.
47      Agrif_UseSpecialValue = .TRUE.
48      ztab = 0.e0
49      CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn)
50      Agrif_UseSpecialValue = .FALSE.
51
52      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab(:,:,:,:)
53
54      spongearea = 2 + 2 * Agrif_irhox()
55
56      localviscsponge = 0.
57     
58      IF (.NOT. spongedoneT) THEN
59         spe1ur(:,:) = 0.
60         spe2vr(:,:) = 0.
61
62      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
63         DO ji = 2, spongearea
64            localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
65         ENDDO
66   
67    spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
68          * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
69
70         spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
71             localviscsponge(2:spongearea,2:jpj)) &
72           * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
73      ENDIF
74
75      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
76         DO ji = nlci-spongearea + 1,nlci-1
77            localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
78         ENDDO
79   
80    spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
81           localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
82          * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
83
84         spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
85              + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
86           * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
87      ENDIF
88
89
90      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
91         DO jj = 2, spongearea
92            localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
93         ENDDO
94   
95    spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
96           localviscsponge(2:jpi,2:spongearea)) &
97          * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
98
99         spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
100             localviscsponge(:,3:spongearea)) &
101           * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
102      ENDIF
103
104      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
105         DO jj = nlcj-spongearea + 1,nlcj-1
106            localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
107         ENDDO
108   
109    spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
110            localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
111          * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
112
113         spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
114            localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
115           * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
116      ENDIF
117     
118         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
119
120         spongedoneT = .TRUE.
121      ENDIF
122
123      DO jl = 1, jptra
124      DO jk = 1, jpkm1
125         DO jj = 1, jpjm1
126            DO ji = 1, jpim1
127               zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
128               zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
129               ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) )
130               ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )
131            ENDDO
132         ENDDO
133
134         DO jj = 2,jpjm1
135            DO ji = 2,jpim1
136               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
137               ! horizontal diffusive trends
138               ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   &
139                  &          + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl)  )
140               ! add it to the general tracer trends
141               tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra)
142            END DO
143         END DO
144
145      ENDDO
146      ENDDO
147 
148      CALL wrk_dealloc( jpi, jpj, localviscsponge )
149      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
150
151#endif
152
153   END SUBROUTINE Agrif_Sponge_Trc
154
155   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,l1,l2)
156      !!---------------------------------------------
157      !!   *** ROUTINE interptn ***
158      !!---------------------------------------------
159#  include "domzgr_substitute.h90"       
160     
161      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
162      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
163
164      tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2)
165
166   END SUBROUTINE interptrn
167
168#else
169CONTAINS
170
171   SUBROUTINE agrif_top_sponge_empty
172      !!---------------------------------------------
173      !!   *** ROUTINE agrif_top_sponge_empty ***
174      !!---------------------------------------------
175      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
176   END SUBROUTINE agrif_top_sponge_empty
177#endif
178
179END MODULE agrif_top_sponge
Note: See TracBrowser for help on using the repository browser.