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_lim2_update.F90 in branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2011/dev_r2802_LOCEAN10_agrif_lim/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90 @ 2804

Last change on this file since 2804 was 2804, checked in by rblod, 13 years ago

dev_r2802_LOCEAN10_agrif_lim: first implementation see ticket #848
File size: 14.6 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.2   !  09-2010  (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
20   !!----------------------------------------------------------------------
21   USE ice_2
22   USE dom_ice_2
23   USE sbc_oce
24   USE dom_oce
25   USE agrif_oce
26   USE agrif_ice 
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC agrif_update_lim2
32
33   !!----------------------------------------------------------------------
34   !! NEMO/NST 3.2 , LOCEAN-IPSL (2010)
35   !! $Id$
36   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
37   !!----------------------------------------------------------------------
38
39CONTAINS
40
41   SUBROUTINE agrif_update_lim2 ( kt )
42      !!----------------------------------------------------------------------
43      !!   *** ROUTINE agrif_update_lim2 ***
44      !!----------------------------------------------------------------------
45      INTEGER, INTENT(in) :: kt
46      !!
47      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
48      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv, zsadv
49      !!----------------------------------------------------------------------
50      !
51      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
52
53      Agrif_UseSpecialValueInUpdate = .TRUE.
54      Agrif_SpecialValueFineGrid = 0.
55
56# if defined TWO_WAY
57      ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7), zsadv(jpi,jpj,42) )
58
59      IF( MOD(nbcline,nbclineupdate) == 0) THEN
60         CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  )
61         CALL Agrif_Update_Variable( zsadv, sadv_ice_id, procname = update_sadv_ice )
62         CALL Agrif_Update_Variable( zvel , u_ice_id   , procname = update_u_ice    )
63         CALL Agrif_Update_Variable( zvel , v_ice_id   , procname = update_v_ice    )
64      ELSE
65         CALL Agrif_Update_Variable( zadv , adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
66         CALL Agrif_Update_Variable( zsadv, sadv_ice_id, locupdate=(/0,2/), procname = update_sadv_ice ) 
67         CALL Agrif_Update_Variable( zvel , u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
68         CALL Agrif_Update_Variable( zvel , v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
69      ENDIF
70
71      DEALLOCATE( zvel, zadv, zsadv )
72# endif
73      !
74   END SUBROUTINE agrif_update_lim2
75
76
77   SUBROUTINE update_adv_ice( tabres, i1, i2, j1, j2, before )
78      !!-----------------------------------------------------------------------
79      !!                         *** ROUTINE update_adv_ice ***
80      !!-----------------------------------------------------------------------
81      INTEGER, INTENT(in) :: i1, i2, j1, j2
82      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
83      LOGICAL, INTENT(in) :: before
84      !!
85      INTEGER :: ji, jj
86      REAL(wp) :: zrhox, zrhoy
87      REAL(wp) :: z1_area
88      !!-----------------------------------------------------------------------
89      !
90      IF( before ) THEN
91         zrhox = Agrif_Rhox()
92         zrhoy = Agrif_Rhoy()
93         DO jj=j1,j2
94            DO ji=i1,i2
95               tabres(ji,jj, 1) = frld  (ji,jj) * area(ji,jj)
96               tabres(ji,jj, 2) = hicif (ji,jj) * area(ji,jj)
97               tabres(ji,jj, 3) = hsnif (ji,jj) * area(ji,jj)
98               tabres(ji,jj, 4) = tbif  (ji,jj,1) * area(ji,jj)
99               tabres(ji,jj, 5) = tbif  (ji,jj,2) * area(ji,jj)
100               tabres(ji,jj, 6) = tbif  (ji,jj,3) * area(ji,jj)
101               tabres(ji,jj, 7) = qstoif(ji,jj) * area(ji,jj)
102            END DO
103         END DO
104         tabres = zrhox * zrhoy * tabres
105      ELSE
106         DO jj=j1,j2
107            DO ji=i1,i2
108               z1_area = 1. / area(ji,jj) * tms(ji,jj)
109               frld  (ji,jj)   = tabres(ji,jj, 1) * z1_area
110               hicif (ji,jj)   = tabres(ji,jj, 2) * z1_area
111               hsnif (ji,jj)   = tabres(ji,jj, 3) * z1_area
112               tbif  (ji,jj,1) = tabres(ji,jj, 4) * z1_area
113               tbif  (ji,jj,2) = tabres(ji,jj, 5) * z1_area
114               tbif  (ji,jj,3) = tabres(ji,jj, 6) * z1_area
115               qstoif(ji,jj)   = tabres(ji,jj, 7) * z1_area
116            END DO
117         END DO
118      ENDIF
119
120   END SUBROUTINE update_adv_ice
121
122#if defined key_lim2_vp
123   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
124      !!-----------------------------------------------------------------------
125      !!                        *** ROUTINE update_u_ice ***
126      !!-----------------------------------------------------------------------
127      INTEGER, INTENT(in) :: i1, i2, j1, j2
128      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
129      LOGICAL, INTENT(in) :: before
130      !!
131      INTEGER :: ji, jj
132      REAL(wp) :: zrhoy
133      !!-----------------------------------------------------------------------
134      !
135      IF( before ) THEN
136         zrhoy = Agrif_Rhoy()
137         DO jj=MAX(j1,2),j2
138            DO ji=MAX(i1,2),i2
139               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
140            END DO
141         END DO
142         tabres = zrhoy * tabres
143      ELSE
144         DO jj= MAX(j1,2),j2
145            DO ji=MAX(i1,2),i2
146               u_ice(ji,jj) = tabres(ji,jj) / (e2f(ji-1,jj-1))
147               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
148            END DO
149         END DO
150      ENDIF
151      !
152   END SUBROUTINE update_u_ice
153
154
155   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
156      !!-----------------------------------------------------------------------
157      !!                    *** ROUTINE update_v_ice ***
158      !!-----------------------------------------------------------------------
159      INTEGER, INTENT(in) :: i1,i2,j1,j2
160      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
161      LOGICAL, INTENT(in) :: before
162      !!
163      INTEGER :: ji, jj
164      REAL(wp) :: zrhox
165      !!-----------------------------------------------------------------------
166      !
167      IF( before ) THEN
168         zrhox = Agrif_Rhox()
169         DO jj=MAX(j1,2),j2
170            DO ji=MAX(i1,2),i2
171               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
172            END DO
173         END DO
174         tabres = zrhox * tabres
175      ELSE
176         DO jj=j1,j2
177            DO ji=i1,i2
178               v_ice(ji,jj) = tabres(ji,jj) / (e1f(ji-1,jj-1))
179               v_ice(ji,jj) = v_ice(ji,jj) * tmu(ji,jj)
180            END DO
181         END DO
182      ENDIF
183      !
184   END SUBROUTINE update_v_ice
185#else
186   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
187      !!-----------------------------------------------------------------------
188      !!                        *** ROUTINE update_u_ice ***
189      !!-----------------------------------------------------------------------
190      INTEGER, INTENT(in) :: i1, i2, j1, j2
191      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
192      LOGICAL, INTENT(in) :: before
193      !!
194      INTEGER :: ji, jj
195      REAL(wp) :: zrhoy
196      !!-----------------------------------------------------------------------
197      !
198      IF( before ) THEN
199         zrhoy = Agrif_Rhoy()
200         DO jj=MAX(j1,2),j2
201            DO ji=MAX(i1,2),i2
202               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
203            END DO
204         END DO
205         tabres = zrhoy * tabres
206      ELSE
207         DO jj=MAX(j1,2),j2
208            DO ji=MAX(i1,2),i2
209               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj))
210               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
211            END DO
212         END DO
213      ENDIF
214      !
215   END SUBROUTINE update_u_ice
216
217
218   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
219      !!-----------------------------------------------------------------------
220      !!                    *** ROUTINE update_v_ice ***
221      !!-----------------------------------------------------------------------
222      INTEGER, INTENT(in) :: i1,i2,j1,j2
223      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
224      LOGICAL, INTENT(in) :: before
225      !!
226      INTEGER :: ji, jj
227      REAL(wp) :: zrhox
228      !!-----------------------------------------------------------------------
229      !
230      IF( before ) THEN
231         zrhox = Agrif_Rhox()
232         DO jj=MAX(j1,2),j2
233            DO ji=MAX(i1,2),i2
234               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
235            END DO
236         END DO
237         tabres = zrhox * tabres
238      ELSE
239         DO jj=j1,j2
240            DO ji=i1,i2
241               v_ice(ji,jj) = tabres(ji,jj) / (e1v(ji,jj))
242               v_ice(ji,jj) = v_ice(ji,jj) * tmv(ji,jj)
243            END DO
244         END DO
245      ENDIF
246      !
247   END SUBROUTINE update_v_ice
248#endif
249
250   SUBROUTINE update_sadv_ice( tabres, i1, i2, j1, j2, before )
251      !!-----------------------------------------------------------------------
252      !!                     *** ROUTINE update_sadv_ice ***
253      !!-----------------------------------------------------------------------
254      !!
255      INTEGER, INTENT(in) :: i1, i2, j1, j2
256      REAL(wp), DIMENSION(i1:i2,j1:j2,42), INTENT(inout) :: tabres
257      LOGICAL, INTENT(in) :: before
258      !!
259      INTEGER :: ji, jj
260      REAL(wp) :: zrhox, zrhoy, zarea, z1_area
261      !!-----------------------------------------------------------------------
262      !
263      IF( before ) THEN
264         zrhox = Agrif_Rhox()
265         zrhoy = Agrif_Rhoy()
266         DO jj=j1,j2
267            DO ji=i1,i2
268               zarea = area(ji,jj)
269               tabres(ji,jj, 1) = sxice (ji,jj) * zarea
270               tabres(ji,jj, 2) = syice (ji,jj) * zarea 
271               tabres(ji,jj, 3) = sxxice(ji,jj) * zarea
272               tabres(ji,jj, 4) = syyice(ji,jj) * zarea
273               tabres(ji,jj, 5) = sxyice(ji,jj) * zarea
274               tabres(ji,jj, 6) = sxa   (ji,jj) * zarea
275               tabres(ji,jj, 7) = sya   (ji,jj) * zarea
276               tabres(ji,jj, 8) = sxxa  (ji,jj) * zarea
277               tabres(ji,jj, 9) = syya  (ji,jj) * zarea
278               tabres(ji,jj,10) = sxya  (ji,jj) * zarea
279               tabres(ji,jj,11) = sxsn  (ji,jj) * zarea
280               tabres(ji,jj,12) = sysn  (ji,jj) * zarea
281               tabres(ji,jj,13) = sxxsn (ji,jj) * zarea
282               tabres(ji,jj,14) = syysn (ji,jj) * zarea
283               tabres(ji,jj,15) = sxysn (ji,jj) * zarea
284               tabres(ji,jj,16) = sxc0  (ji,jj) * zarea
285               tabres(ji,jj,17) = syc0  (ji,jj) * zarea
286               tabres(ji,jj,18) = sxxc0 (ji,jj) * zarea
287               tabres(ji,jj,19) = syyc0 (ji,jj) * zarea
288               tabres(ji,jj,20) = sxyc0 (ji,jj) * zarea
289               tabres(ji,jj,21) = sxc1  (ji,jj) * zarea
290               tabres(ji,jj,22) = syc1  (ji,jj) * zarea
291               tabres(ji,jj,23) = sxxc1 (ji,jj) * zarea
292               tabres(ji,jj,24) = syyc1 (ji,jj) * zarea
293               tabres(ji,jj,25) = sxyc1 (ji,jj) * zarea
294               tabres(ji,jj,26) = sxc2  (ji,jj) * zarea
295               tabres(ji,jj,27) = syc2  (ji,jj) * zarea
296               tabres(ji,jj,28) = sxxc2 (ji,jj) * zarea
297               tabres(ji,jj,29) = syyc2 (ji,jj) * zarea
298               tabres(ji,jj,30) = sxyc2 (ji,jj) * zarea
299               tabres(ji,jj,31) = sxst  (ji,jj) * zarea
300               tabres(ji,jj,32) = syst  (ji,jj) * zarea
301               tabres(ji,jj,33) = sxxst (ji,jj) * zarea
302               tabres(ji,jj,34) = syyst (ji,jj) * zarea
303               tabres(ji,jj,35) = sxyst (ji,jj) * zarea
304            END DO
305         END DO
306         tabres = zrhox * zrhoy * tabres
307      ELSE
308         DO jj=j1,j2
309            DO ji=i1,i2
310               z1_area = 1. / area(ji,jj) * tms(ji,jj)
311               sxice (ji,jj) =  tabres(ji,jj, 1) * z1_area
312               syice (ji,jj) = tabres(ji,jj, 2) * z1_area 
313               sxxice(ji,jj) = tabres(ji,jj, 3) * z1_area
314               syyice(ji,jj) = tabres(ji,jj, 4) * z1_area
315               sxyice(ji,jj) = tabres(ji,jj, 5) * z1_area
316               sxa   (ji,jj) = tabres(ji,jj, 6) * z1_area
317               sya   (ji,jj) = tabres(ji,jj, 7) * z1_area
318               sxxa  (ji,jj) = tabres(ji,jj, 8) * z1_area
319               syya  (ji,jj) = tabres(ji,jj, 9) * z1_area
320               sxya  (ji,jj) = tabres(ji,jj,10) * z1_area
321               sxsn  (ji,jj) = tabres(ji,jj,11) * z1_area
322               sysn  (ji,jj) = tabres(ji,jj,12) * z1_area
323               sxxsn (ji,jj) = tabres(ji,jj,13) * z1_area
324               syysn (ji,jj) = tabres(ji,jj,14) * z1_area
325               sxysn (ji,jj) = tabres(ji,jj,15) * z1_area
326               sxc0  (ji,jj) = tabres(ji,jj,16) * z1_area
327               syc0  (ji,jj) = tabres(ji,jj,17) * z1_area
328               sxxc0 (ji,jj) = tabres(ji,jj,18) * z1_area
329               syyc0 (ji,jj) = tabres(ji,jj,19) * z1_area
330               sxyc0 (ji,jj) = tabres(ji,jj,20) * z1_area
331               sxc1  (ji,jj) = tabres(ji,jj,21) * z1_area
332               syc1  (ji,jj) = tabres(ji,jj,22) * z1_area
333               sxxc1 (ji,jj) = tabres(ji,jj,23) * z1_area
334               syyc1 (ji,jj) = tabres(ji,jj,24) * z1_area
335               sxyc1 (ji,jj) = tabres(ji,jj,25) * z1_area
336               sxc2  (ji,jj) = tabres(ji,jj,26) * z1_area
337               syc2  (ji,jj) = tabres(ji,jj,27) * z1_area
338               sxxc2 (ji,jj) = tabres(ji,jj,28) * z1_area
339               syyc2 (ji,jj) = tabres(ji,jj,29) * z1_area
340               sxyc2 (ji,jj) = tabres(ji,jj,30) * z1_area
341               sxst  (ji,jj) = tabres(ji,jj,31) * z1_area
342               syst  (ji,jj) = tabres(ji,jj,32) * z1_area
343               sxxst (ji,jj) = tabres(ji,jj,33) * z1_area
344               syyst (ji,jj) = tabres(ji,jj,34) * z1_area
345               sxyst (ji,jj) = tabres(ji,jj,35) * z1_area
346            END DO
347         END DO
348      ENDIF
349
350   END SUBROUTINE update_sadv_ice
351
352#else
353CONTAINS
354   SUBROUTINE agrif_lim2_update_empty
355      !!---------------------------------------------
356      !!   *** ROUTINE agrif_lim2_update_empty ***
357      !!---------------------------------------------
358      WRITE(*,*)  'agrif_lim2_update : You should not have seen this print! error?'
359   END SUBROUTINE agrif_lim2_update_empty
360#endif
361END MODULE agrif_lim2_update
Note: See TracBrowser for help on using the repository browser.