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 @ 6746

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

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