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/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90 @ 10236

Last change on this file since 10236 was 8058, checked in by jgraham, 7 years ago

Clear keywords

File size: 10.0 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      IF( MOD(nbcline,nbclineupdate) == 0) THEN
62         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  )
63         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
64         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
65      ELSE
66         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  )
67         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
68         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
69      ENDIF
70# endif
71      !
72   END SUBROUTINE agrif_update_lim2
73
74
75   SUBROUTINE update_adv_ice( tabres, i1, i2, j1, j2, before )
76      !!-----------------------------------------------------------------------
77      !!                        *** ROUTINE update_adv_ice ***
78      !! ** Method  : Compute the mass properties on the fine grid and recover
79      !!              the properties per mass on the coarse grid
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
123# if defined key_lim2_vp
124   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
125      !!-----------------------------------------------------------------------
126      !!                        *** ROUTINE update_u_ice ***
127      !! ** Method  : Update the fluxes and recover the properties (B-grid)
128      !!-----------------------------------------------------------------------
129      INTEGER, INTENT(in) :: i1, i2, j1, j2
130      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
131      LOGICAL, INTENT(in) :: before
132      !!
133      INTEGER :: ji, jj
134      REAL(wp) :: zrhoy
135      !!-----------------------------------------------------------------------
136      !
137      IF( before ) THEN
138         zrhoy = Agrif_Rhoy()
139         DO jj=MAX(j1,2),j2
140            DO ji=MAX(i1,2),i2
141               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
142            END DO
143         END DO
144         tabres = zrhoy * tabres
145      ELSE
146         DO jj= MAX(j1,2),j2
147            DO ji=MAX(i1,2),i2
148               u_ice(ji,jj) = tabres(ji,jj) / (e2f(ji-1,jj-1))
149               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
150            END DO
151         END DO
152      ENDIF
153      !
154   END SUBROUTINE update_u_ice
155
156
157   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
158      !!-----------------------------------------------------------------------
159      !!                    *** ROUTINE update_v_ice ***
160      !! ** Method  : Update the fluxes and recover the properties (B-grid)
161      !!-----------------------------------------------------------------------
162      INTEGER, INTENT(in) :: i1,i2,j1,j2
163      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
164      LOGICAL, INTENT(in) :: before
165      !!
166      INTEGER :: ji, jj
167      REAL(wp) :: zrhox
168      !!-----------------------------------------------------------------------
169      !
170      IF( before ) THEN
171         zrhox = Agrif_Rhox()
172         DO jj=MAX(j1,2),j2
173            DO ji=MAX(i1,2),i2
174               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
175            END DO
176         END DO
177         tabres = zrhox * tabres
178      ELSE
179         DO jj=j1,j2
180            DO ji=i1,i2
181               v_ice(ji,jj) = tabres(ji,jj) / (e1f(ji-1,jj-1))
182               v_ice(ji,jj) = v_ice(ji,jj) * tmu(ji,jj)
183            END DO
184         END DO
185      ENDIF
186      !
187   END SUBROUTINE update_v_ice
188# else
189   SUBROUTINE update_u_ice( tabres, i1, i2, j1, j2, before )
190      !!-----------------------------------------------------------------------
191      !!                        *** ROUTINE update_u_ice ***
192      !! ** Method  : Update the fluxes and recover the properties (C-grid)
193      !!-----------------------------------------------------------------------
194      INTEGER, INTENT(in) :: i1, i2, j1, j2
195      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
196      LOGICAL, INTENT(in) :: before
197      !!
198      INTEGER :: ji, jj
199      REAL(wp) :: zrhoy
200      !!-----------------------------------------------------------------------
201      !
202      IF( before ) THEN
203         zrhoy = Agrif_Rhoy()
204         DO jj=MAX(j1,2),j2
205            DO ji=MAX(i1,2),i2
206               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
207            END DO
208         END DO
209         tabres = zrhoy * tabres
210      ELSE
211         DO jj=MAX(j1,2),j2
212            DO ji=MAX(i1,2),i2
213               u_ice(ji,jj) = tabres(ji,jj) / (e2u(ji,jj))
214               u_ice(ji,jj) = u_ice(ji,jj) * tmu(ji,jj)
215            END DO
216         END DO
217      ENDIF
218      !
219   END SUBROUTINE update_u_ice
220
221
222   SUBROUTINE update_v_ice( tabres, i1, i2, j1, j2, before )
223      !!-----------------------------------------------------------------------
224      !!                    *** ROUTINE update_v_ice ***
225      !! ** Method  : Update the fluxes and recover the properties (C-grid)
226      !!-----------------------------------------------------------------------
227      INTEGER, INTENT(in) :: i1,i2,j1,j2
228      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: tabres
229      LOGICAL, INTENT(in) :: before
230      !!
231      INTEGER :: ji, jj
232      REAL(wp) :: zrhox
233      !!-----------------------------------------------------------------------
234      !
235      IF( before ) THEN
236         zrhox = Agrif_Rhox()
237         DO jj=MAX(j1,2),j2
238            DO ji=MAX(i1,2),i2
239               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
240            END DO
241         END DO
242         tabres = zrhox * tabres
243      ELSE
244         DO jj=j1,j2
245            DO ji=i1,i2
246               v_ice(ji,jj) = tabres(ji,jj) / (e1v(ji,jj))
247               v_ice(ji,jj) = v_ice(ji,jj) * tmv(ji,jj)
248            END DO
249         END DO
250      ENDIF
251      !
252   END SUBROUTINE update_v_ice
253# endif
254
255#else
256CONTAINS
257   SUBROUTINE agrif_lim2_update_empty
258      !!---------------------------------------------
259      !!   *** ROUTINE agrif_lim2_update_empty ***
260      !!---------------------------------------------
261      WRITE(*,*)  'agrif_lim2_update : You should not have seen this print! error?'
262   END SUBROUTINE agrif_lim2_update_empty
263#endif
264END MODULE agrif_lim2_update
Note: See TracBrowser for help on using the repository browser.