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/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90 @ 8965

Last change on this file since 8965 was 8901, checked in by jchanut, 6 years ago

AGRIF: Remove update frequency parameter from namelist - #1965

  • Property svn:keywords set to Id
File size: 9.9 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      !!----------------------------------------------------------------------
55      !
56      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
57
58      Agrif_UseSpecialValueInUpdate = .TRUE.
59      Agrif_SpecialValueFineGrid = 0.
60# if defined TWO_WAY
61      CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
62      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
63      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
64!      CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
65!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
66!      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
67# endif
68      !
69   END SUBROUTINE agrif_update_lim2
70
71
72   SUBROUTINE update_adv_ice( tabres, i1, i2, j1, j2, before )
73      !!-----------------------------------------------------------------------
74      !!                        *** ROUTINE update_adv_ice ***
75      !! ** Method  : Compute the mass properties on the fine grid and recover
76      !!              the properties per mass on the coarse grid
77      !!-----------------------------------------------------------------------
78      INTEGER, INTENT(in) :: i1, i2, j1, j2
79      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
80      LOGICAL, INTENT(in) :: before
81      !!
82      INTEGER :: ji, jj
83      REAL(wp) :: zrhox, zrhoy
84      REAL(wp) :: z1_area
85      !!-----------------------------------------------------------------------
86      !
87      IF( before ) THEN
88         zrhox = Agrif_Rhox()
89         zrhoy = Agrif_Rhoy()
90         DO jj=j1,j2
91            DO ji=i1,i2
92               tabres(ji,jj, 1) = frld  (ji,jj  ) * area(ji,jj)
93               tabres(ji,jj, 2) = hicif (ji,jj  ) * area(ji,jj)
94               tabres(ji,jj, 3) = hsnif (ji,jj  ) * area(ji,jj)
95               tabres(ji,jj, 4) = tbif  (ji,jj,1) * area(ji,jj)
96               tabres(ji,jj, 5) = tbif  (ji,jj,2) * area(ji,jj)
97               tabres(ji,jj, 6) = tbif  (ji,jj,3) * area(ji,jj)
98               tabres(ji,jj, 7) = qstoif(ji,jj  ) * area(ji,jj)
99            END DO
100         END DO
101         tabres = zrhox * zrhoy * tabres
102      ELSE
103         DO jj=j1,j2
104            DO ji=i1,i2
105               z1_area = 1. / area(ji,jj) * tms(ji,jj)
106               frld  (ji,jj)   = tabres(ji,jj, 1) * z1_area
107               hicif (ji,jj)   = tabres(ji,jj, 2) * z1_area
108               hsnif (ji,jj)   = tabres(ji,jj, 3) * z1_area
109               tbif  (ji,jj,1) = tabres(ji,jj, 4) * z1_area
110               tbif  (ji,jj,2) = tabres(ji,jj, 5) * z1_area
111               tbif  (ji,jj,3) = tabres(ji,jj, 6) * z1_area
112               qstoif(ji,jj)   = tabres(ji,jj, 7) * z1_area
113            END DO
114         END DO
115      ENDIF
116      !
117   END SUBROUTINE update_adv_ice
118
119
120# if defined key_lim2_vp
121   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
122      !!-----------------------------------------------------------------------
123      !!                        *** ROUTINE update_u_ice ***
124      !! ** Method  : Update the fluxes and recover the properties (B-grid)
125      !!-----------------------------------------------------------------------
126      INTEGER, INTENT(in) :: i1, i2, j1, j2
127      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
128      LOGICAL, INTENT(in) :: before
129      !!
130      INTEGER :: ji, jj
131      REAL(wp) :: zrhoy
132      !!-----------------------------------------------------------------------
133      !
134      IF( before ) THEN
135         zrhoy = Agrif_Rhoy()
136         DO jj=MAX(j1,2),j2
137            DO ji=MAX(i1,2),i2
138               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
139            END DO
140         END DO
141         tabres = zrhoy * tabres
142      ELSE
143         DO jj= MAX(j1,2),j2
144            DO ji=MAX(i1,2),i2
145               u_ice(ji,jj) = tabres(ji,jj) / (e2f(ji-1,jj-1))
146               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
147            END DO
148         END DO
149      ENDIF
150      !
151   END SUBROUTINE update_u_ice
152
153
154   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
155      !!-----------------------------------------------------------------------
156      !!                    *** ROUTINE update_v_ice ***
157      !! ** Method  : Update the fluxes and recover the properties (B-grid)
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      !! ** Method  : Update the fluxes and recover the properties (C-grid)
190      !!-----------------------------------------------------------------------
191      INTEGER, INTENT(in) :: i1, i2, j1, j2
192      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
193      LOGICAL, INTENT(in) :: before
194      !!
195      INTEGER :: ji, jj
196      REAL(wp) :: zrhoy
197      !!-----------------------------------------------------------------------
198      !
199      IF( before ) THEN
200         zrhoy = Agrif_Rhoy()
201         DO jj=MAX(j1,2),j2
202            DO ji=MAX(i1,2),i2
203               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
204            END DO
205         END DO
206         tabres = zrhoy * tabres
207      ELSE
208         DO jj=MAX(j1,2),j2
209            DO ji=MAX(i1,2),i2
210               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj))
211               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
212            END DO
213         END DO
214      ENDIF
215      !
216   END SUBROUTINE update_u_ice
217
218
219   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
220      !!-----------------------------------------------------------------------
221      !!                    *** ROUTINE update_v_ice ***
222      !! ** Method  : Update the fluxes and recover the properties (C-grid)
223      !!-----------------------------------------------------------------------
224      INTEGER, INTENT(in) :: i1,i2,j1,j2
225      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
226      LOGICAL, INTENT(in) :: before
227      !!
228      INTEGER :: ji, jj
229      REAL(wp) :: zrhox
230      !!-----------------------------------------------------------------------
231      !
232      IF( before ) THEN
233         zrhox = Agrif_Rhox()
234         DO jj=MAX(j1,2),j2
235            DO ji=MAX(i1,2),i2
236               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
237            END DO
238         END DO
239         tabres = zrhox * tabres
240      ELSE
241         DO jj=j1,j2
242            DO ji=i1,i2
243               v_ice(ji,jj) = tabres(ji,jj) / (e1v(ji,jj))
244               v_ice(ji,jj) = v_ice(ji,jj) * tmv(ji,jj)
245            END DO
246         END DO
247      ENDIF
248      !
249   END SUBROUTINE update_v_ice
250# endif
251
252#else
253CONTAINS
254   SUBROUTINE agrif_lim2_update_empty
255      !!---------------------------------------------
256      !!   *** ROUTINE agrif_lim2_update_empty ***
257      !!---------------------------------------------
258      WRITE(*,*)  'agrif_lim2_update : You should not have seen this print! error?'
259   END SUBROUTINE agrif_lim2_update_empty
260#endif
261END MODULE agrif_lim2_update
Note: See TracBrowser for help on using the repository browser.