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

source: branches/UKMO/dev_r5518_medusa_fix_restart/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90 @ 7850

Last change on this file since 7850 was 7850, checked in by marc, 7 years ago

Removing the SVN keywords

File size: 3.4 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 agrif_opa_sponge
11   USE trc
12   USE lib_mpp
13   USE wrk_nemo 
14
15   IMPLICIT NONE
16   PRIVATE
17
18   PUBLIC Agrif_Sponge_Trc, interptrn
19
20  !! * Substitutions
21#  include "domzgr_substitute.h90"
22   !!----------------------------------------------------------------------
23   !! NEMO/NST 3.3 , NEMO Consortium (2010)
24   !! $Id$
25   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
27
28   CONTAINS
29
30   SUBROUTINE Agrif_Sponge_Trc
31      !!---------------------------------------------
32      !!   *** ROUTINE Agrif_Sponge_Trc ***
33      !!---------------------------------------------
34      !!
35      INTEGER :: ji,jj,jk,jn
36      REAL(wp) :: timecoeff
37      REAL(wp) :: ztra, zabe1, zabe2, zbtr
38      REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv
39      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr
40      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff
41
42#if defined SPONGE_TOP
43      CALL wrk_alloc( jpi, jpj, ztru, ztrv )
44      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )
45
46      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
47
48      Agrif_SpecialValue=0.
49      Agrif_UseSpecialValue = .TRUE.
50      ztabr = 0.e0
51      CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn)
52      Agrif_UseSpecialValue = .FALSE.
53
54      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)
55
56      CALL Agrif_sponge
57
58      DO jn = 1, jptra
59         DO jk = 1, jpkm1
60            !
61            DO jj = 1, jpjm1
62               DO ji = 1, jpim1
63                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
64                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
65                  ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
66                  ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
67               ENDDO
68            ENDDO
69
70            DO jj = 2,jpjm1
71               DO ji = 2,jpim1
72                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
73                  ! horizontal diffusive trends
74                  ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  )
75                  ! add it to the general tracer trends
76                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
77               END DO
78            END DO
79            !
80         ENDDO
81      ENDDO
82 
83      CALL wrk_dealloc( jpi, jpj, ztru, ztrv )
84      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )
85
86#endif
87
88   END SUBROUTINE Agrif_Sponge_Trc
89
90   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
91      !!---------------------------------------------
92      !!   *** ROUTINE interptn ***
93      !!---------------------------------------------
94      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
95      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
96      !
97      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
98
99   END SUBROUTINE interptrn
100
101#else
102CONTAINS
103
104   SUBROUTINE agrif_top_sponge_empty
105      !!---------------------------------------------
106      !!   *** ROUTINE agrif_top_sponge_empty ***
107      !!---------------------------------------------
108      WRITE(*,*)  'agrif_top_sponge : You should not have seen this print! error?'
109   END SUBROUTINE agrif_top_sponge_empty
110#endif
111
112END MODULE agrif_top_sponge
Note: See TracBrowser for help on using the repository browser.