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_update.F90 in branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90 @ 8189

Last change on this file since 8189 was 8189, checked in by clem, 7 years ago

bug fixes for ghostcells>1
File size: 9.9 KB
Line 
1#define TWO_WAY
2
3MODULE agrif_lim3_update
4   !!=====================================================================================
5   !!                       ***  MODULE agrif_lim3_update ***
6   !! Nesting module :  update surface ocean boundary condition over ice from a child grid
7   !! Sea-Ice model  :  LIM 3.6 Sea ice model time-stepping
8   !!=====================================================================================
9   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
10   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
11   !!            3.6   !  05-2016  (C. Rousset)  Add LIM3 compatibility
12   !!----------------------------------------------------------------------
13#if defined key_agrif && defined key_lim3
14   !!----------------------------------------------------------------------
15   !!   'key_lim3'  :                                 LIM 3.6 sea-ice model
16   !!   'key_agrif' :                                 AGRIF library
17   !!----------------------------------------------------------------------
18   !!   agrif_update_lim3  : update sea-ice on boundaries or total
19   !!                        child domain for velocities and ice properties
20   !!   update_tra_ice     : sea-ice properties
21   !!   update_u_ice       : zonal      ice velocity
22   !!   update_v_ice       : meridional ice velocity
23   !!----------------------------------------------------------------------
24   USE dom_oce
25   USE sbc_oce
26   USE agrif_oce
27   USE ice
28   USE agrif_ice 
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC agrif_update_lim3
34
35   !!----------------------------------------------------------------------
36   !! NEMO/NST 3.6 , LOCEAN-IPSL (2016)
37   !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $
38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE agrif_update_lim3( kt )
44      !!----------------------------------------------------------------------
45      !!                     *** ROUTINE agrif_update_lim3 ***
46      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or the entire domain
47      !!
48      !! ** Action : - Update (u_ice,v_ice) and ice tracers
49      !!----------------------------------------------------------------------
50      INTEGER, INTENT(in) :: kt
51      !!
52      !!----------------------------------------------------------------------
53      !
54      !! clem: I think the update should take place each time the ocean sees the surface forcings
55      !!       (but maybe I am wrong and we should update every rhot time steps)
56      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement
57                                                                                                                           ! i.e. update only at the parent time step
58      IF( nn_ice == 0 ) RETURN   ! clem2017: do not update if child domain does not have ice
59      !
60      Agrif_SpecialValueFineGrid = -9999.
61      Agrif_UseSpecialValueInUpdate = .TRUE.
62# if defined TWO_WAY
63      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
64                                                ! nbcline is incremented (+1) at the end of each parent time step from 0 (1st time step)
65         CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
66         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
67         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
68      ELSE                                      ! update only the boundaries defined par locupdate
69         CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  )
70         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
71         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
72      ENDIF
73# endif
74      Agrif_SpecialValueFineGrid = 0.
75      Agrif_UseSpecialValueInUpdate = .FALSE.
76      !
77   END SUBROUTINE agrif_update_lim3
78
79
80   !!------------------
81   !! Local subroutines
82   !!------------------
83   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
84      !!-----------------------------------------------------------------------
85      !!                        *** ROUTINE update_tra_ice ***
86      !! ** Method  : Compute the mass properties on the fine grid and recover
87      !!              the properties per mass on the coarse grid
88      !!-----------------------------------------------------------------------
89      INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2
90      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
91      LOGICAL , INTENT(in) :: before
92      !!
93      INTEGER  :: ji, jj, jk, jl, jm
94      !!-----------------------------------------------------------------------
95      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
96      IF( before ) THEN
97         jm = 1
98         DO jl = 1, jpl
99            ptab(i1:i2,j1:j2,jm  ) = a_i  (i1:i2,j1:j2,jl)
100            ptab(i1:i2,j1:j2,jm+1) = v_i  (i1:i2,j1:j2,jl)
101            ptab(i1:i2,j1:j2,jm+2) = v_s  (i1:i2,j1:j2,jl)
102            ptab(i1:i2,j1:j2,jm+3) = smv_i(i1:i2,j1:j2,jl)
103            ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl)
104            jm = jm + 5
105            DO jk = 1, nlay_s
106               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
107            ENDDO
108            DO jk = 1, nlay_i
109               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
110            ENDDO
111         ENDDO
112         !
113         DO jk = k1, k2
114            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
115         ENDDO
116         !
117      ELSE
118         !
119         jm = 1
120         DO jl = 1, jpl
121            !
122            DO jj = j1, j2
123               DO ji = i1, i2
124                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN
125                     a_i  (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
126                     v_i  (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
127                     v_s  (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
128                     smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
129                     oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
130                  ENDIF
131               ENDDO
132            ENDDO
133            jm = jm + 5
134            !
135            DO jk = 1, nlay_s
136               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
137                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
138               ENDWHERE
139               jm = jm + 1
140            ENDDO
141            !
142            DO jk = 1, nlay_i
143               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
144                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
145               ENDWHERE
146               jm = jm + 1
147            ENDDO
148            !
149         ENDDO
150         !
151         ! integrated values
152         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
153         vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 )
154         at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 )
155         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
156         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
157         
158      ENDIF
159      !
160   END SUBROUTINE update_tra_ice
161
162
163   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
164      !!-----------------------------------------------------------------------
165      !!                        *** ROUTINE update_u_ice ***
166      !! ** Method  : Update the fluxes and recover the properties (C-grid)
167      !!-----------------------------------------------------------------------
168      INTEGER , INTENT(in) :: i1, i2, j1, j2
169      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
170      LOGICAL , INTENT(in) :: before
171      !!
172      REAL(wp) :: zrhoy
173      !!-----------------------------------------------------------------------
174      !
175      IF( before ) THEN
176         zrhoy = Agrif_Rhoy()
177         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
178         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid
179      ELSE
180         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
181            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
182         ENDWHERE
183      ENDIF
184      !
185   END SUBROUTINE update_u_ice
186
187
188   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
189      !!-----------------------------------------------------------------------
190      !!                    *** ROUTINE update_v_ice ***
191      !! ** Method  : Update the fluxes and recover the properties (C-grid)
192      !!-----------------------------------------------------------------------
193      INTEGER , INTENT(in) :: i1,i2,j1,j2
194      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab
195      LOGICAL , INTENT(in) :: before
196      !!
197      REAL(wp) :: zrhox
198      !!-----------------------------------------------------------------------
199      !
200      IF( before ) THEN
201         zrhox = Agrif_Rhox()
202         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
203         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid
204      ELSE
205         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
206            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
207         ENDWHERE
208      ENDIF
209      !
210   END SUBROUTINE update_v_ice
211
212#else
213CONTAINS
214   SUBROUTINE agrif_lim3_update_empty
215      !!---------------------------------------------
216      !!   *** ROUTINE agrif_lim3_update_empty ***
217      !!---------------------------------------------
218      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?'
219   END SUBROUTINE agrif_lim3_update_empty
220#endif
221END MODULE agrif_lim3_update
Note: See TracBrowser for help on using the repository browser.