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 NEMO/trunk/src/NST – NEMO

source: NEMO/trunk/src/NST/agrif_top_sponge.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 7.1 KB
Line 
1#define SPONGE_TOP
2
3MODULE agrif_top_sponge
4   !!======================================================================
5   !!                ***  MODULE agrif_top_sponge  ***
6   !! AGRIF :   sponge layer pakage for passive tracers (TOP)
7   !!======================================================================
8   !! History :  2.0  ! 2006-08  (R. Benshila, L. Debreu)  Original code
9   !!----------------------------------------------------------------------
10#if defined key_agrif && defined key_top
11   !!----------------------------------------------------------------------
12   !!   Agrif_Sponge_trc :
13   !!   interptrn_sponge : 
14   !!----------------------------------------------------------------------
15   USE par_oce
16   USE par_trc
17   USE oce
18   USE trc
19   USE dom_oce
20   USE agrif_oce
21   USE agrif_oce_sponge
22   USE vremap
23   !
24   USE in_out_manager
25   USE lib_mpp
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC Agrif_Sponge_trc, interptrn_sponge
31
32   !!----------------------------------------------------------------------
33   !! NEMO/NST 4.0 , NEMO Consortium (2018)
34   !! $Id$
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE Agrif_Sponge_trc
40      !!----------------------------------------------------------------------
41      !!                   *** ROUTINE Agrif_Sponge_Trc ***
42      !!----------------------------------------------------------------------
43      REAL(wp) ::   zcoef   ! local scalar
44      !!----------------------------------------------------------------------
45      !
46#if defined SPONGE_TOP
47!! Assume persistence
48      zcoef = REAL(Agrif_rhot()-1,wp)/REAL(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=zcoef, 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, ztrelax
70      REAL(wp), DIMENSION(i1:i2,j1:j2)               ::   ztu, ztv
71      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,1:jptra) ::   trbdiff
72      ! vertical interpolation:
73      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,1:jptra) ::tabres_child
74      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin
75      REAL(wp), DIMENSION(k1:k2) :: h_in
76      REAL(wp), DIMENSION(1:jpk) :: h_out
77      INTEGER :: N_in, N_out
78      REAL(wp) :: h_diff
79      !!----------------------------------------------------------------------
80      !
81      IF( before ) THEN
82         DO jn = 1, jptra
83            DO jk=k1,k2
84               DO jj=j1,j2
85                  DO ji=i1,i2
86                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kbb_a)
87                  END DO
88               END DO
89            END DO
90         END DO
91
92# if defined key_vertical
93         DO jk=k1,k2
94            DO jj=j1,j2
95               DO ji=i1,i2
96                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
97               END DO
98            END DO
99         END DO
100# endif
101      ELSE     
102# if defined key_vertical
103         tabres_child(:,:,:,:) = 0.
104         DO jj=j1,j2
105            DO ji=i1,i2
106               N_in = 0
107               DO jk=k1,k2 !k2 = jpk of parent grid
108                  IF (tabres(ji,jj,jk,n2) == 0) EXIT
109                  N_in = N_in + 1
110                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)
111                  h_in(N_in) = tabres(ji,jj,jk,n2)
112               END DO
113               N_out = 0
114               DO jk=1,jpk ! jpk of child grid
115                  IF (tmask(ji,jj,jk) == 0) EXIT
116                  N_out = N_out + 1
117                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
118               ENDDO
119               IF (N_in > 0) THEN
120                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,tabres_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra)
121               ENDIF
122            ENDDO
123         ENDDO
124# endif
125
126         DO jj=j1,j2
127            DO ji=i1,i2
128               DO jk=1,jpkm1
129# if defined key_vertical
130                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra)
131# else
132                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)
133# endif
134               ENDDO
135            ENDDO
136         ENDDO
137
138         !* set relaxation time scale
139         IF( neuler == 0 .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rdt )
140         ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rdt )
141         ENDIF
142
143         DO jn = 1, jptra
144            DO jk = 1, jpkm1
145               DO jj = j1,j2-1
146                  DO ji = i1,i2-1
147                     zabe1 = rn_sponge_tra * fspu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk)
148                     zabe2 = rn_sponge_tra * fspv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk)
149                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
150                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
151                  END DO
152               END DO
153               !
154               DO jj = j1+1,j2-1
155                  DO ji = i1+1,i2-1
156                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN
157                        tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
158                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
159                           &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)  &
160                           &                                - ztrelax * fspt(ji,jj) * trbdiff(ji,jj,jk,jn)
161                     ENDIF
162                  END DO
163               END DO
164            END DO
165            !
166         END DO
167         !
168         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
169      ENDIF
170      !                 
171   END SUBROUTINE interptrn_sponge
172
173#else
174   !!----------------------------------------------------------------------
175   !!   Empty module                                           no TOP AGRIF
176   !!----------------------------------------------------------------------
177CONTAINS
178   SUBROUTINE agrif_top_sponge_empty
179      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
180   END SUBROUTINE agrif_top_sponge_empty
181#endif
182
183   !!======================================================================
184END MODULE agrif_top_sponge
Note: See TracBrowser for help on using the repository browser.