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 @ 2760

Last change on this file since 2760 was 2715, checked in by rblod, 13 years ago

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