source: NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_top_interp.F90 @ 11590

Last change on this file since 11590 was 11590, checked in by jchanut, 16 months ago

#2222: 1) create remapping module (vremap) and integration of D. Engwirda piecewise polynomial recontruction package (PPR_LIB cpp key). 2) Various bug corrections with key_vertical activated.

  • Property svn:keywords set to Id
File size: 5.0 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 )
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      !
58      INTEGER  ::   ji, jj, jk, jn, ibdy, jbdy   ! dummy loop indices
59      INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out
60      REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7
61
62      ! vertical interpolation:
63      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child
64      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
65      REAL(wp), DIMENSION(k1:k2) :: h_in
66      REAL(wp), DIMENSION(1:jpk) :: h_out
67      !!----------------------------------------------------------------------
68
69      IF( before ) THEN         
70         DO jn = 1,jptra
71            DO jk=k1,k2
72               DO jj=j1,j2
73                 DO ji=i1,i2
74                       ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
75                 END DO
76              END DO
77           END DO
78        END DO
79
80# if defined key_vertical
81        DO jk=k1,k2
82           DO jj=j1,j2
83              DO ji=i1,i2
84                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
85              END DO
86           END DO
87        END DO
88# endif
89      ELSE 
90
91# if defined key_vertical
92         DO jj=j1,j2
93            DO ji=i1,i2
94               N_in = 0
95               DO jk=k1,k2 !k2 = jpk of parent grid
96                  IF (ptab(ji,jj,jk,n2) == 0) EXIT
97                  N_in = N_in + 1
98                  tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1)
99                  h_in(N_in) = ptab(ji,jj,jk,n2)
100               END DO
101               N_out = 0
102               DO jk=1,jpk ! jpk of child grid
103                  IF (tmask(ji,jj,jk) == 0) EXIT
104                  N_out = N_out + 1
105                  h_out(jk) = e3t_a(ji,jj,jk)
106               ENDDO
107               IF (N_in > 0) THEN
108                  DO jn=1,jptra
109                     call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
110                  ENDDO
111               ENDIF
112            ENDDO
113         ENDDO
114# else
115         ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra)
116# endif
117         !
118         DO jn=1, jptra
119            tra(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 
120         END DO
121
122      ENDIF
123      !
124   END SUBROUTINE interptrn
125
126#else
127   !!----------------------------------------------------------------------
128   !!   Empty module                                           no TOP AGRIF
129   !!----------------------------------------------------------------------
130CONTAINS
131   SUBROUTINE Agrif_TOP_Interp_empty
132      !!---------------------------------------------
133      !!   *** ROUTINE agrif_Top_Interp_empty ***
134      !!---------------------------------------------
135      WRITE(*,*)  'agrif_top_interp : You should not have seen this print! error?'
136   END SUBROUTINE Agrif_TOP_Interp_empty
137#endif
138
139   !!======================================================================
140END MODULE agrif_top_interp
Note: See TracBrowser for help on using the repository browser.