source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90 @ 5706

Last change on this file since 5706 was 3680, checked in by rblod, 9 years ago

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028

  • Property svn:keywords set to Id
File size: 10.2 KB
Line 
1#define TWO_WAY
2
3MODULE agrif_lim2_update
4   !!======================================================================
5   !!                       ***  MODULE agrif_lim2_update ***
6   !! Nesting module :  update surface ocean boundary condition over ice
7   !!                   from a child grif
8   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
9   !!======================================================================
10   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
11   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
12   !!----------------------------------------------------------------------
13#if defined key_agrif && defined key_lim2
14   !!----------------------------------------------------------------------
15   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
16   !!   'key_agrif' :                                 AGRIF library
17   !!----------------------------------------------------------------------
18   !!   agrif_update_lim2  : update sea-ice model on boundaries or total
19   !!                        sea-ice area for velocities and ice properties
20   !!   update_adv_ice     : sea-ice properties
21   !!   update_u_ice       : zonal ice velocity
22   !!   update_v_ice       : meridional ice velocity
23   !!----------------------------------------------------------------------
24   USE ice_2
25   USE dom_ice_2
26   USE sbc_oce
27   USE dom_oce
28   USE agrif_oce
29   USE agrif_ice 
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC agrif_update_lim2
35
36   !!----------------------------------------------------------------------
37   !! NEMO/NST 3.4 , LOCEAN-IPSL (2012)
38   !! $Id$
39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE agrif_update_lim2 ( kt )
45      !!----------------------------------------------------------------------
46      !!                     *** ROUTINE agrif_update_lim2 ***
47      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or
48      !!                the entire domain
49      !!
50      !! ** Action : - Update (u_ice,v_ice) and ice tracers
51      !!----------------------------------------------------------------------
52      INTEGER, INTENT(in) :: kt
53      !!
54      REAL(wp), DIMENSION(jpi,jpj)  :: zvel
55      REAL(wp), DIMENSION(jpi,jpj,7):: zadv
56      !!----------------------------------------------------------------------
57      !
58      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
59
60      Agrif_UseSpecialValueInUpdate = .TRUE.
61      Agrif_SpecialValueFineGrid = 0.
62
63# if defined TWO_WAY
64      IF( MOD(nbcline,nbclineupdate) == 0) THEN
65         CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  )
66         CALL Agrif_Update_Variable( zvel , u_ice_id   , procname = update_u_ice    )
67         CALL Agrif_Update_Variable( zvel , v_ice_id   , procname = update_v_ice    )
68      ELSE
69         CALL Agrif_Update_Variable( zadv , adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
70         CALL Agrif_Update_Variable( zvel , u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
71         CALL Agrif_Update_Variable( zvel , v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
72      ENDIF
73# endif
74      !
75   END SUBROUTINE agrif_update_lim2
76
77
78   SUBROUTINE update_adv_ice( tabres, i1, i2, j1, j2, before )
79      !!-----------------------------------------------------------------------
80      !!                        *** ROUTINE update_adv_ice ***
81      !! ** Method  : Compute the mass properties on the fine grid and recover
82      !!              the properties per mass on the coarse grid
83      !!-----------------------------------------------------------------------
84      INTEGER, INTENT(in) :: i1, i2, j1, j2
85      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
86      LOGICAL, INTENT(in) :: before
87      !!
88      INTEGER :: ji, jj
89      REAL(wp) :: zrhox, zrhoy
90      REAL(wp) :: z1_area
91      !!-----------------------------------------------------------------------
92      !
93      IF( before ) THEN
94         zrhox = Agrif_Rhox()
95         zrhoy = Agrif_Rhoy()
96         DO jj=j1,j2
97            DO ji=i1,i2
98               tabres(ji,jj, 1) = frld  (ji,jj  ) * area(ji,jj)
99               tabres(ji,jj, 2) = hicif (ji,jj  ) * area(ji,jj)
100               tabres(ji,jj, 3) = hsnif (ji,jj  ) * area(ji,jj)
101               tabres(ji,jj, 4) = tbif  (ji,jj,1) * area(ji,jj)
102               tabres(ji,jj, 5) = tbif  (ji,jj,2) * area(ji,jj)
103               tabres(ji,jj, 6) = tbif  (ji,jj,3) * area(ji,jj)
104               tabres(ji,jj, 7) = qstoif(ji,jj  ) * area(ji,jj)
105            END DO
106         END DO
107         tabres = zrhox * zrhoy * tabres
108      ELSE
109         DO jj=j1,j2
110            DO ji=i1,i2
111               z1_area = 1. / area(ji,jj) * tms(ji,jj)
112               frld  (ji,jj)   = tabres(ji,jj, 1) * z1_area
113               hicif (ji,jj)   = tabres(ji,jj, 2) * z1_area
114               hsnif (ji,jj)   = tabres(ji,jj, 3) * z1_area
115               tbif  (ji,jj,1) = tabres(ji,jj, 4) * z1_area
116               tbif  (ji,jj,2) = tabres(ji,jj, 5) * z1_area
117               tbif  (ji,jj,3) = tabres(ji,jj, 6) * z1_area
118               qstoif(ji,jj)   = tabres(ji,jj, 7) * z1_area
119            END DO
120         END DO
121      ENDIF
122      !
123   END SUBROUTINE update_adv_ice
124
125
126# if defined key_lim2_vp
127   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
128      !!-----------------------------------------------------------------------
129      !!                        *** ROUTINE update_u_ice ***
130      !! ** Method  : Update the fluxes and recover the properties (B-grid)
131      !!-----------------------------------------------------------------------
132      INTEGER, INTENT(in) :: i1, i2, j1, j2
133      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
134      LOGICAL, INTENT(in) :: before
135      !!
136      INTEGER :: ji, jj
137      REAL(wp) :: zrhoy
138      !!-----------------------------------------------------------------------
139      !
140      IF( before ) THEN
141         zrhoy = Agrif_Rhoy()
142         DO jj=MAX(j1,2),j2
143            DO ji=MAX(i1,2),i2
144               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
145            END DO
146         END DO
147         tabres = zrhoy * tabres
148      ELSE
149         DO jj= MAX(j1,2),j2
150            DO ji=MAX(i1,2),i2
151               u_ice(ji,jj) = tabres(ji,jj) / (e2f(ji-1,jj-1))
152               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
153            END DO
154         END DO
155      ENDIF
156      !
157   END SUBROUTINE update_u_ice
158
159
160   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
161      !!-----------------------------------------------------------------------
162      !!                    *** ROUTINE update_v_ice ***
163      !! ** Method  : Update the fluxes and recover the properties (B-grid)
164      !!-----------------------------------------------------------------------
165      INTEGER, INTENT(in) :: i1,i2,j1,j2
166      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
167      LOGICAL, INTENT(in) :: before
168      !!
169      INTEGER :: ji, jj
170      REAL(wp) :: zrhox
171      !!-----------------------------------------------------------------------
172      !
173      IF( before ) THEN
174         zrhox = Agrif_Rhox()
175         DO jj=MAX(j1,2),j2
176            DO ji=MAX(i1,2),i2
177               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
178            END DO
179         END DO
180         tabres = zrhox * tabres
181      ELSE
182         DO jj=j1,j2
183            DO ji=i1,i2
184               v_ice(ji,jj) = tabres(ji,jj) / (e1f(ji-1,jj-1))
185               v_ice(ji,jj) = v_ice(ji,jj) * tmu(ji,jj)
186            END DO
187         END DO
188      ENDIF
189      !
190   END SUBROUTINE update_v_ice
191# else
192   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
193      !!-----------------------------------------------------------------------
194      !!                        *** ROUTINE update_u_ice ***
195      !! ** Method  : Update the fluxes and recover the properties (C-grid)
196      !!-----------------------------------------------------------------------
197      INTEGER, INTENT(in) :: i1, i2, j1, j2
198      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
199      LOGICAL, INTENT(in) :: before
200      !!
201      INTEGER :: ji, jj
202      REAL(wp) :: zrhoy
203      !!-----------------------------------------------------------------------
204      !
205      IF( before ) THEN
206         zrhoy = Agrif_Rhoy()
207         DO jj=MAX(j1,2),j2
208            DO ji=MAX(i1,2),i2
209               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
210            END DO
211         END DO
212         tabres = zrhoy * tabres
213      ELSE
214         DO jj=MAX(j1,2),j2
215            DO ji=MAX(i1,2),i2
216               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj))
217               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
218            END DO
219         END DO
220      ENDIF
221      !
222   END SUBROUTINE update_u_ice
223
224
225   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
226      !!-----------------------------------------------------------------------
227      !!                    *** ROUTINE update_v_ice ***
228      !! ** Method  : Update the fluxes and recover the properties (C-grid)
229      !!-----------------------------------------------------------------------
230      INTEGER, INTENT(in) :: i1,i2,j1,j2
231      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
232      LOGICAL, INTENT(in) :: before
233      !!
234      INTEGER :: ji, jj
235      REAL(wp) :: zrhox
236      !!-----------------------------------------------------------------------
237      !
238      IF( before ) THEN
239         zrhox = Agrif_Rhox()
240         DO jj=MAX(j1,2),j2
241            DO ji=MAX(i1,2),i2
242               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
243            END DO
244         END DO
245         tabres = zrhox * tabres
246      ELSE
247         DO jj=j1,j2
248            DO ji=i1,i2
249               v_ice(ji,jj) = tabres(ji,jj) / (e1v(ji,jj))
250               v_ice(ji,jj) = v_ice(ji,jj) * tmv(ji,jj)
251            END DO
252         END DO
253      ENDIF
254      !
255   END SUBROUTINE update_v_ice
256# endif
257
258#else
259CONTAINS
260   SUBROUTINE agrif_lim2_update_empty
261      !!---------------------------------------------
262      !!   *** ROUTINE agrif_lim2_update_empty ***
263      !!---------------------------------------------
264      WRITE(*,*)  'agrif_lim2_update : You should not have seen this print! error?'
265   END SUBROUTINE agrif_lim2_update_empty
266#endif
267END MODULE agrif_lim2_update
Note: See TracBrowser for help on using the repository browser.