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_lim3_interp.F90 in branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90 @ 6584

Last change on this file since 6584 was 6584, checked in by clem, 8 years ago

LIM3 and Agrif compatibility
File size: 9.0 KB
Line 
1MODULE agrif_lim3_interp
2   !!=====================================================================================
3   !!                       ***  MODULE agrif_lim3_interp ***
4   !! Nesting module :  interp surface ocean boundary condition over ice from a parent grid
5   !! Sea-Ice model  :  LIM 3.6 Sea ice model time-stepping
6   !!=====================================================================================
7   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
8   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
9   !!            3.6   !  05-2016  (C. Rousset)  Add LIM3 compatibility
10   !!----------------------------------------------------------------------
11#if defined key_agrif && defined key_lim3 
12   !!----------------------------------------------------------------------
13   !!   'key_lim3'  :                                 LIM 3.6 sea-ice model
14   !!   'key_agrif' :                                 AGRIF library
15   !!----------------------------------------------------------------------
16   !!  agrif_interp_lim3    : interpolation of ice at "after" sea-ice time step
17   !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice
18   !!  agrif_interp_v_ice   : atomic routine to interpolate v_ice
19   !!  agrif_interp_tra_ice : atomic routine to interpolate ice properties
20   !!----------------------------------------------------------------------
21   USE par_oce
22   USE dom_oce
23   USE sbc_oce
24   USE ice
25   USE dom_ice
26   USE agrif_ice
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC agrif_interp_lim3
32
33   !!----------------------------------------------------------------------
34   !! NEMO/NST 3.6 , NEMO Consortium (2016)
35   !! $Id: agrif_lim3_interp.F90 6204 2016-01-04 13:47:06Z cetlod $
36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
38
39CONTAINS
40
41   SUBROUTINE agrif_interp_lim3( cd_type )
42      !!-----------------------------------------------------------------------
43      !!                 *** ROUTINE agrif_rhg_lim3  ***
44      !!
45      !!  ** Method  : simple call to atomic routines using stored values to
46      !!  fill the boundaries depending of the position of the point and
47      !!  computing factor for time interpolation
48      !!-----------------------------------------------------------------------
49      CHARACTER(len=1), INTENT( in ) :: cd_type
50      !!   
51      REAL(wp) :: zbeta
52      !!-----------------------------------------------------------------------
53      !
54      IF( Agrif_Root() )  RETURN
55      !
56      zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
57      !
58      ! clem: calledweight = zbeta(1/3;2/3;1) => 2/3*var1+1/3*var2 puis 1/3;2/3 puis 0;1
59      Agrif_SpecialValue=-9999.
60      Agrif_UseSpecialValue = .TRUE.
61      SELECT CASE(cd_type)
62      CASE('U')
63         CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta )
64      CASE('V')
65         CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta )
66      CASE('T')
67         CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta )
68      END SELECT
69      Agrif_SpecialValue=0.
70      Agrif_UseSpecialValue = .FALSE.
71      !
72   END SUBROUTINE agrif_interp_lim3
73
74   !!------------------
75   !! Local subroutines
76   !!------------------
77   SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before )
78      !!-----------------------------------------------------------------------
79      !!                     *** ROUTINE interp_u_ice ***
80      !!
81      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
82      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
83      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
84      !!-----------------------------------------------------------------------
85      INTEGER , INTENT(in) :: i1, i2, j1, j2
86      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
87      LOGICAL , INTENT(in) :: before
88      !!
89      REAL(wp) :: zrhoy
90      !!-----------------------------------------------------------------------
91      !
92      IF( before ) THEN  ! parent grid
93         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2)
94         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
95      ELSE               ! child grid
96         zrhoy = Agrif_Rhoy()
97         u_ice(i1:i2,j1:j2) = ptab(:,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
98      ENDIF
99      !
100   END SUBROUTINE interp_u_ice
101
102
103   SUBROUTINE interp_v_ice( ptab, i1, i2, j1, j2, before )
104      !!-----------------------------------------------------------------------
105      !!                    *** ROUTINE interp_v_ice ***
106      !!
107      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
108      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
109      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
110      !!-----------------------------------------------------------------------     
111      INTEGER , INTENT(in) :: i1, i2, j1, j2
112      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
113      LOGICAL , INTENT(in) :: before
114      !!
115      REAL(wp) :: zrhox
116      !!-----------------------------------------------------------------------
117      !
118      IF( before ) THEN  ! parent grid
119         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2)
120         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
121      ELSE               ! child grid
122         zrhox = Agrif_Rhox()
123         v_ice(i1:i2,j1:j2) = ptab(:,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
124      ENDIF
125      !
126   END SUBROUTINE interp_v_ice
127
128
129   SUBROUTINE interp_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
130      !!-----------------------------------------------------------------------
131      !!                    *** ROUTINE interp_tra_ice ***                           
132      !!
133      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
134      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points,
135      !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around
136      !!-----------------------------------------------------------------------
137      INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2
138      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
139      LOGICAL , INTENT(in) :: before
140      !!
141      INTEGER :: jk, jl, jm
142      !!-----------------------------------------------------------------------
143      ! clem: pkoi on n'utilise pas les quantités intégrées ici => before: * e12t ; after: * r1_e12t / rhox / rhoy
144      ! a priori c'est ok comme ca (cf ce qui est fait dans l'ocean). Je ne sais pas pkoi ceci dit
145      IF( before ) THEN  ! parent grid
146         jm = 1
147         DO jl = 1, jpl
148            ptab(:,:,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
149            ptab(:,:,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
150            ptab(:,:,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1
151            ptab(:,:,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1
152            ptab(:,:,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1
153            DO jk = 1, nlay_s
154               ptab(:,:,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
155            ENDDO
156            DO jk = 1, nlay_i
157               ptab(:,:,jm) = e_i_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
158            ENDDO
159         ENDDO
160         !!ptab(:,:,jm) = ato_i(i1:i2,j1:j2)
161         
162         DO jk = k1, k2
163            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
164         ENDDO
165         
166      ELSE               ! child grid
167         jm = 1
168         DO jl = 1, jpl
169            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
170            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
171            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
172            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
173            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
174            DO jk = 1, nlay_s
175               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
176            ENDDO
177            DO jk = 1, nlay_i
178               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
179            ENDDO
180         ENDDO
181         !!ato_i(i1:i2,j1:j2) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)
182         
183      ENDIF
184      !
185   END SUBROUTINE interp_tra_ice
186
187#else
188CONTAINS
189   SUBROUTINE agrif_lim3_interp_empty
190      !!---------------------------------------------
191      !!   *** ROUTINE agrif_lim3_interp_empty ***
192      !!---------------------------------------------
193      WRITE(*,*)  'agrif_lim3_interp : You should not have seen this print! error?'
194   END SUBROUTINE agrif_lim3_interp_empty
195#endif
196END MODULE agrif_lim3_interp
Note: See TracBrowser for help on using the repository browser.