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_interp.F90 in branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 6 years ago

Remove svn keywords
File size: 7.5 KB
RevLine 
[636]1MODULE agrif_top_interp
[1206]2#if defined key_agrif && defined key_top
[636]3   USE par_oce
4   USE oce
5   USE dom_oce     
6   USE sol_oce
[782]7   USE agrif_oce
[2715]8   USE agrif_top_sponge
[6204]9   USE par_trc
[1271]10   USE trc
[2715]11   USE lib_mpp
[3294]12   USE wrk_nemo 
[628]13
[636]14   IMPLICIT NONE
15   PRIVATE
[628]16
[6204]17   PUBLIC Agrif_trc, interptrn
[636]18
[2715]19#  include "domzgr_substitute.h90" 
20#  include "vectopt_loop_substitute.h90"
21  !!----------------------------------------------------------------------
[6204]22   !! NEMO/NST 3.6 , NEMO Consortium (2010)
[1156]23   !! $Id$
[2528]24   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1156]25   !!----------------------------------------------------------------------
26
[636]27   CONTAINS
28
[1271]29   SUBROUTINE Agrif_trc
[3680]30      !!----------------------------------------------------------------------
[6204]31      !!                  ***  ROUTINE Agrif_trc  ***
[3680]32      !!----------------------------------------------------------------------
33      !
34      IF( Agrif_Root() )   RETURN
[628]35
[3680]36      Agrif_SpecialValue    = 0.e0
[636]37      Agrif_UseSpecialValue = .TRUE.
[628]38
[6204]39      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
[636]40      Agrif_UseSpecialValue = .FALSE.
[6204]41      !
42   END SUBROUTINE Agrif_trc
[636]43
[6204]44   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)
45      !!---------------------------------------------
46      !!   *** ROUTINE interptrn ***
47      !!---------------------------------------------
48      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
49      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
50      LOGICAL, INTENT(in) :: before
51      INTEGER, INTENT(in) :: nb , ndir
52      !
53      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
54      INTEGER :: imin, imax, jmin, jmax
55      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3
56      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7
57      LOGICAL :: western_side, eastern_side,northern_side,southern_side
[636]58
[6204]59      IF (before) THEN         
60         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2)
61      ELSE
62         !
63         western_side  = (nb == 1).AND.(ndir == 1)
64         eastern_side  = (nb == 1).AND.(ndir == 2)
65         southern_side = (nb == 2).AND.(ndir == 1)
66         northern_side = (nb == 2).AND.(ndir == 2)
67         !
68         zrhox = Agrif_Rhox()
69         !
70         zalpha1 = ( zrhox - 1. ) * 0.5
71         zalpha2 = 1. - zalpha1
72         !
73         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
74         zalpha4 = 1. - zalpha3
75         !
76         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
77         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
78         zalpha5 = 1. - zalpha6 - zalpha7
79         !
80         imin = i1
81         imax = i2
82         jmin = j1
83         jmax = j2
84         !
85         ! Remove CORNERS
86         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
87         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
88         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
89         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2       
90         !
91         IF( eastern_side) THEN
92            DO jn = 1, jptra
93               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn)
94               DO jk = 1, jpkm1
95                  DO jj = jmin,jmax
96                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
97                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
98                     ELSE
99                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
100                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
101                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 
102                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
103                        ENDIF
[636]104                     ENDIF
[6204]105                  END DO
[636]106               END DO
[6204]107            ENDDO
108         ENDIF
109         !
110         IF( northern_side ) THEN           
111            DO jn = 1, jptra
112               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)
113               DO jk = 1, jpkm1
114                  DO ji = imin,imax
115                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
116                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
117                     ELSE
118                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)       
119                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
120                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  &
121                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
122                        ENDIF
[636]123                     ENDIF
[6204]124                  END DO
[636]125               END DO
[6204]126            ENDDO
127         ENDIF
128         !
129         IF( western_side) THEN           
130            DO jn = 1, jptra
131               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)
132               DO jk = 1, jpkm1
133                  DO jj = jmin,jmax
134                     IF( umask(2,jj,jk) == 0.e0 ) THEN
135                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
136                     ELSE
137                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)       
138                        IF( un(2,jj,jk) < 0.e0 ) THEN
139                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
140                        ENDIF
[636]141                     ENDIF
[6204]142                  END DO
[636]143               END DO
144            END DO
[6204]145         ENDIF
146         !
147         IF( southern_side ) THEN           
148            DO jn = 1, jptra
149               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)
150               DO jk=1,jpk     
151                  DO ji=imin,imax
152                     IF( vmask(ji,2,jk) == 0.e0 ) THEN
153                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
154                     ELSE
155                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
156                        IF( vn(ji,2,jk) < 0.e0 ) THEN
157                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
158                        ENDIF
[636]159                     ENDIF
[6204]160                  END DO
[636]161               END DO
[6204]162            ENDDO
163         ENDIF
164         !
165         ! Treatment of corners
166         !
167         ! East south
168         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
169            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)
170         ENDIF
171         ! East north
172         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
173            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)
174         ENDIF
175         ! West south
176         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
177            tra(2,2,:,:) = ptab(2,2,:,:)
178         ENDIF
179         ! West north
180         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
181            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)
182         ENDIF
183         !
[628]184      ENDIF
[3680]185      !
[6204]186   END SUBROUTINE interptrn
[2715]187
[628]188#else
[636]189CONTAINS
190   SUBROUTINE Agrif_TOP_Interp_empty
191      !!---------------------------------------------
192      !!   *** ROUTINE agrif_Top_Interp_empty ***
193      !!---------------------------------------------
194      WRITE(*,*)  'agrif_top_interp : You should not have seen this print! error?'
195   END SUBROUTINE Agrif_TOP_Interp_empty
[628]196#endif
[636]197END MODULE agrif_top_interp
Note: See TracBrowser for help on using the repository browser.