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_ice_update.F90 in NEMO/trunk/src/NST – NEMO

source: NEMO/trunk/src/NST/agrif_ice_update.F90 @ 9748

Last change on this file since 9748 was 9656, checked in by clem, 6 years ago

remove the remaining references to LIM
File size: 9.7 KB
Line 
1#define TWO_WAY
2!!#undef TWO_WAY
3
4MODULE agrif_ice_update
5   !!=====================================================================================
6   !!                       ***  MODULE agrif_ice_update ***
7   !! Nesting module :  update surface ocean boundary condition over ice from a child grid
8   !!=====================================================================================
9   !! History :  2.0   !  04-2008  (F. Dupont)               initial version
10   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
11   !!            4.0   !  2018     (C. Rousset)              SI3 compatibility
12   !!----------------------------------------------------------------------
13#if defined key_agrif && defined key_si3
14   !!----------------------------------------------------------------------
15   !!   'key_si3'  :                                      SI3 sea-ice model
16   !!   'key_agrif' :                                     AGRIF library
17   !!----------------------------------------------------------------------
18   !!   agrif_update_ice  : 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   USE phycst , ONLY: rt0
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   agrif_update_ice   ! called by agrif_user.F90 and icestp.F90
35
36   !!----------------------------------------------------------------------
37   !! NEMO/NST 4.0 , NEMO Consortium (2018)
38   !! $Id: agrif_ice_update.F90 6204 2016-01-04 13:47:06Z cetlod $
39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE agrif_update_ice( kt )
44      !!----------------------------------------------------------------------
45      !!                     *** ROUTINE agrif_update_ice ***
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      IF( Agrif_Root() .OR. nn_ice == 0 ) RETURN   ! do not update if inside Parent Grid or if child domain does not have ice
54      !
55      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc)/nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN   ! update only at the parent ice time step
56      !
57      Agrif_SpecialValueFineGrid    = -9999.
58      Agrif_UseSpecialValueInUpdate = .TRUE.
59# if defined TWO_WAY
60      CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
61      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
62      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
63
64!      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_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      Agrif_SpecialValueFineGrid    = 0.
69      Agrif_UseSpecialValueInUpdate = .FALSE.
70      !
71   END SUBROUTINE agrif_update_ice
72
73
74   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
75      !!-----------------------------------------------------------------------
76      !!                        *** ROUTINE update_tra_ice ***
77      !! ** Method  : Compute the mass properties on the fine grid and recover
78      !!              the properties per mass on the coarse grid
79      !!-----------------------------------------------------------------------
80      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
81      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
82      LOGICAL                               , INTENT(in   ) ::   before
83      !!
84      INTEGER  :: ji, jj, jk, jl, jm
85      !!-----------------------------------------------------------------------
86      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
87      IF( before ) THEN
88         jm = 1
89         DO jl = 1, jpl
90            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl)
91            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl)
92            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl)
93            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl)
94            ptab(i1:i2,j1:j2,jm+4) = oa_i(i1:i2,j1:j2,jl)
95            ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl)
96            ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl)
97            ptab(i1:i2,j1:j2,jm+7) = t_su(i1:i2,j1:j2,jl)
98            jm = jm + 8
99            DO jk = 1, nlay_s
100               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
101            END DO
102            DO jk = 1, nlay_i
103               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
104            END DO
105         END DO
106         !
107         DO jk = k1, k2
108            WHERE( tmask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
109         END DO
110         !
111      ELSE
112         !
113         jm = 1
114         DO jl = 1, jpl
115            !
116            DO jj = j1, j2
117               DO ji = i1, i2
118                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN
119                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
120                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
121                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
122                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
123                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
124                     a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1)
125                     v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1)
126                     t_su(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1)
127                  ENDIF
128               END DO
129            END DO
130            jm = jm + 8
131            !
132            DO jk = 1, nlay_s
133               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
134                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
135               ENDWHERE
136               jm = jm + 1
137            END DO
138            !
139            DO jk = 1, nlay_i
140               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
141                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
142               ENDWHERE
143               jm = jm + 1
144            END DO
145            !
146         END DO
147         !
148         DO jl = 1, jpl
149            WHERE( tmask(i1:i2,j1:j2,1) == 0._wp )   t_su(i1:i2,j1:j2,jl) = rt0   ! to avoid a division by 0 in sbcblk.F90
150         END DO
151         
152      ENDIF
153      !
154   END SUBROUTINE update_tra_ice
155
156
157   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
158      !!-----------------------------------------------------------------------
159      !!                        *** ROUTINE update_u_ice ***
160      !! ** Method  : Update the fluxes and recover the properties (C-grid)
161      !!-----------------------------------------------------------------------
162      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
163      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
164      LOGICAL                         , INTENT(in   ) ::   before
165      !!
166      REAL(wp) ::   zrhoy   ! local scalar
167      !!-----------------------------------------------------------------------
168      !
169      IF( before ) THEN
170         zrhoy = Agrif_Rhoy()
171         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
172         WHERE( umask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
173      ELSE
174         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
175            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
176         ENDWHERE
177      ENDIF
178      !
179   END SUBROUTINE update_u_ice
180
181
182   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
183      !!-----------------------------------------------------------------------
184      !!                    *** ROUTINE update_v_ice ***
185      !! ** Method  : Update the fluxes and recover the properties (C-grid)
186      !!-----------------------------------------------------------------------
187      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
188      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
189      LOGICAL                         , INTENT(in   ) ::   before
190      !!
191      REAL(wp) ::   zrhox   ! local scalar
192      !!-----------------------------------------------------------------------
193      !
194      IF( before ) THEN
195         zrhox = Agrif_Rhox()
196         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
197         WHERE( vmask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
198      ELSE
199         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
200            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
201         ENDWHERE
202      ENDIF
203      !
204   END SUBROUTINE update_v_ice
205
206#else
207   !!----------------------------------------------------------------------
208   !!   Empty module                                             no sea-ice
209   !!----------------------------------------------------------------------
210CONTAINS
211   SUBROUTINE agrif_ice_update_empty
212      WRITE(*,*)  'agrif_ice_update : You should not have seen this print! error?'
213   END SUBROUTINE agrif_ice_update_empty
214#endif
215
216   !!======================================================================
217END MODULE agrif_ice_update
Note: See TracBrowser for help on using the repository browser.