source: NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_top_interp.F90 @ 11219

Last change on this file since 11219 was 11219, checked in by jchanut, 15 months ago

#2199
1) Define aditionnal arrays to correct the time interpolation of barotropic arrays in corners. Since multiple stages in the time interpolation are necessary, overlapping segments in corners give wrong results otherwise (corrects stage 2 in previous commit)..
2) Added subroutine to correct time extrapolated fluxes at bdy in time splitting routine (updates stage 3 in previous commit).
3) Completly remove non-specified open boundary case. Boundares are now exactly set from parent (no more filtering nor extrapolation for outgoing flows).
At this stage, use of nbondi, nbondj variables has been completly removed.

  • Property svn:keywords set to Id
File size: 5.5 KB
Line 
1MODULE agrif_top_interp
2   !!======================================================================
3   !!                   ***  MODULE  agrif_top_interp  ***
4   !! AGRIF: interpolation package for TOP
5   !!======================================================================
6   !! History :  2.0  !  ???
7   !!----------------------------------------------------------------------
8#if defined key_agrif && defined key_top
9   !!----------------------------------------------------------------------
10   !!   'key_agrif'                                              AGRIF zoom
11   !!   'key_top'                                           on-line tracers
12   !!----------------------------------------------------------------------
13   USE par_oce
14   USE oce
15   USE dom_oce     
16   USE agrif_oce
17   USE agrif_top_sponge
18   USE par_trc
19   USE trc
20   !
21   USE lib_mpp     ! MPP library
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC Agrif_trc, interptrn
27
28  !!----------------------------------------------------------------------
29   !! NEMO/NST 4.0 , NEMO Consortium (2018)
30   !! $Id$
31   !! Software governed by the CeCILL license (see ./LICENSE)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE Agrif_trc
36      !!----------------------------------------------------------------------
37      !!                   ***  ROUTINE Agrif_trc  ***
38      !!----------------------------------------------------------------------
39      !
40      IF( Agrif_Root() )   RETURN
41      !
42      Agrif_SpecialValue    = 0._wp
43      Agrif_UseSpecialValue = .TRUE.
44      !
45      CALL Agrif_Bc_variable( trn_id, procname=interptrn )
46      Agrif_UseSpecialValue = .FALSE.
47      !
48   END SUBROUTINE Agrif_trc
49
50   SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
51      !!----------------------------------------------------------------------
52      !!                  *** ROUTINE interptrn ***
53      !!----------------------------------------------------------------------
54      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab
55      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2
56      LOGICAL                                     , INTENT(in   ) ::   before
57      INTEGER                                     , INTENT(in   ) ::   nb , ndir
58      !
59      INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices
60      INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out
61      REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7
62      LOGICAL :: western_side, eastern_side,northern_side,southern_side
63      ! vertical interpolation:
64      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child
65      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
66      REAL(wp), DIMENSION(k1:k2) :: h_in
67      REAL(wp), DIMENSION(1:jpk) :: h_out
68      REAL(wp) :: h_diff
69
70      IF( before ) THEN         
71         DO jn = 1,jptra
72            DO jk=k1,k2
73               DO jj=j1,j2
74                 DO ji=i1,i2
75                       ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
76                 END DO
77              END DO
78           END DO
79        END DO
80
81# if defined key_vertical
82        DO jk=k1,k2
83           DO jj=j1,j2
84              DO ji=i1,i2
85                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
86              END DO
87           END DO
88        END DO
89# endif
90      ELSE 
91
92# if defined key_vertical
93         western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2)
94         southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2)
95
96         DO jj=j1,j2
97            DO ji=i1,i2
98               iref = ji
99               jref = jj
100               if(western_side) iref=MAX(2,ji)
101               if(eastern_side) iref=MIN(nlci-1,ji)
102               if(southern_side) jref=MAX(2,jj)
103               if(northern_side) jref=MIN(nlcj-1,jj)
104               N_in = 0
105               DO jk=k1,k2 !k2 = jpk of parent grid
106                  IF (ptab(ji,jj,jk,n2) == 0) EXIT
107                  N_in = N_in + 1
108                  tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1)
109                  h_in(N_in) = ptab(ji,jj,jk,n2)
110               END DO
111               N_out = 0
112               DO jk=1,jpk ! jpk of child grid
113                  IF (tmask(iref,jref,jk) == 0) EXIT
114                  N_out = N_out + 1
115                  h_out(jk) = e3t_n(iref,jref,jk)
116               ENDDO
117               IF (N_in > 0) THEN
118                  DO jn=1,jptra
119                     call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
120                  ENDDO
121               ENDIF
122            ENDDO
123         ENDDO
124# else
125         ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra)
126# endif
127         !
128         DO jn=1, jptra
129            tra(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
130         END DO
131
132      ENDIF
133      !
134   END SUBROUTINE interptrn
135
136#else
137   !!----------------------------------------------------------------------
138   !!   Empty module                                           no TOP AGRIF
139   !!----------------------------------------------------------------------
140CONTAINS
141   SUBROUTINE Agrif_TOP_Interp_empty
142      !!---------------------------------------------
143      !!   *** ROUTINE agrif_Top_Interp_empty ***
144      !!---------------------------------------------
145      WRITE(*,*)  'agrif_top_interp : You should not have seen this print! error?'
146   END SUBROUTINE Agrif_TOP_Interp_empty
147#endif
148
149   !!======================================================================
150END MODULE agrif_top_interp
Note: See TracBrowser for help on using the repository browser.