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

source: branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90 @ 8129

Last change on this file since 8129 was 8129, checked in by clem, 7 years ago

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