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/branches/2019/dev_r11351_fldread_with_XIOS/src/NST – NEMO

source: NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/NST/agrif_ice_update.F90 @ 13463

Last change on this file since 13463 was 13463, checked in by andmirek, 4 years ago

Ticket #2195:update to trunk 13461
  • Property svn:keywords set to Id
File size: 10.7 KB
Line 
1#undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/
2
3MODULE agrif_ice_update
4   !!=====================================================================================
5   !!                       ***  MODULE agrif_ice_update ***
6   !! Nesting module :  update surface ocean boundary condition over ice from a child grid
7   !!=====================================================================================
8   !! History :  2.0   !  04-2008  (F. Dupont)               initial version
9   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
10   !!            4.0   !  2018     (C. Rousset)              SI3 compatibility
11   !!----------------------------------------------------------------------
12#if defined key_agrif && defined key_si3
13   !!----------------------------------------------------------------------
14   !!   'key_si3'  :                                      SI3 sea-ice model
15   !!   'key_agrif' :                                     AGRIF library
16   !!----------------------------------------------------------------------
17   !!   agrif_update_ice  : update sea-ice on boundaries or total
18   !!                        child domain for velocities and ice properties
19   !!   update_tra_ice    : sea-ice properties
20   !!   update_u_ice      : zonal      ice velocity
21   !!   update_v_ice      : meridional ice velocity
22   !!----------------------------------------------------------------------
23   USE dom_oce
24   USE sbc_oce
25   USE agrif_oce
26   USE ice
27   USE agrif_ice 
28   USE phycst , ONLY: rt0
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   agrif_update_ice   ! called by agrif_user.F90 and icestp.F90
34
35   !!----------------------------------------------------------------------
36   !! NEMO/NST 4.0 , NEMO Consortium (2018)
37   !! $Id$
38   !! Software governed by the CeCILL license (see ./LICENSE)
39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE agrif_update_ice( )
43      !!----------------------------------------------------------------------
44      !!                     *** ROUTINE agrif_update_ice ***
45      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or the entire domain
46      !!
47      !! ** Action : - Update (u_ice,v_ice) and ice tracers
48      !!----------------------------------------------------------------------
49      !
50      IF( Agrif_Root() .OR. nn_ice == 0 ) RETURN   ! do not update if inside Parent Grid or if child domain does not have ice
51      !
52!      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
53      IF ( MOD(Agrif_parent_nb_step(), Agrif_Parent(nn_fsbc)) /=0 ) RETURN   ! Update only at the parent ice time step
54                                                                             ! It is assumed that at such a time, there is a child ice step which is true
55                                                                             ! as long as MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc )==0.
56                                                                             ! (This condition is checked in agrif_user, Agrif_InitValues_cont_ice subroutine)
57      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update sea ice from grid Number',Agrif_Fixed(), agrif_nb_step()
58      !
59      !
60      Agrif_SpecialValueFineGrid    = -9999.
61      Agrif_UseSpecialValueInUpdate = .TRUE.
62
63# if ! defined DECAL_FEEDBACK
64      CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
65#else
66      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/1,0/), procname = update_tra_ice  )
67#endif
68      use_sign_north = .TRUE.
69      sign_north = -1.
70
71# if ! defined DECAL_FEEDBACK
72      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
73      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
74#else
75      CALL Agrif_Update_Variable( u_ice_id   , locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname=update_u_ice) 
76      CALL Agrif_Update_Variable( v_ice_id   , locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname=update_v_ice)
77#endif
78      use_sign_north = .FALSE.
79!      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  )
80!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
81!      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
82      Agrif_SpecialValueFineGrid    = 0.
83      Agrif_UseSpecialValueInUpdate = .FALSE.
84      !
85   END SUBROUTINE agrif_update_ice
86
87
88   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
89      !!-----------------------------------------------------------------------
90      !!                        *** ROUTINE update_tra_ice ***
91      !! ** Method  : Compute the mass properties on the fine grid and recover
92      !!              the properties per mass on the coarse grid
93      !!-----------------------------------------------------------------------
94      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
95      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
96      LOGICAL                               , INTENT(in   ) ::   before
97      !!
98      INTEGER  :: ji, jj, jk, jl, jm
99      !!-----------------------------------------------------------------------
100      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
101      IF( before ) THEN
102         jm = 1
103         DO jl = 1, jpl
104            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl)
105            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl)
106            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl)
107            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl)
108            ptab(i1:i2,j1:j2,jm+4) = oa_i(i1:i2,j1:j2,jl)
109            ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl)
110            ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl)
111            ptab(i1:i2,j1:j2,jm+7) = t_su(i1:i2,j1:j2,jl)
112            jm = jm + 8
113            DO jk = 1, nlay_s
114               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
115            END DO
116            DO jk = 1, nlay_i
117               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
118            END DO
119         END DO
120         !
121         DO jk = k1, k2
122            WHERE( tmask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
123         END DO
124         !
125      ELSE
126         !
127         jm = 1
128         DO jl = 1, jpl
129            !
130            DO jj = j1, j2
131               DO ji = i1, i2
132                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN
133                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
134                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
135                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
136                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
137                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
138                     a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1)
139                     v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1)
140                     t_su(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1)
141                  ENDIF
142               END DO
143            END DO
144            jm = jm + 8
145            !
146            DO jk = 1, nlay_s
147               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
148                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
149               ENDWHERE
150               jm = jm + 1
151            END DO
152            !
153            DO jk = 1, nlay_i
154               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
155                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
156               ENDWHERE
157               jm = jm + 1
158            END DO
159            !
160         END DO
161         !
162         DO jl = 1, jpl
163            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
164         END DO
165         
166      ENDIF
167      !
168   END SUBROUTINE update_tra_ice
169
170
171   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
172      !!-----------------------------------------------------------------------
173      !!                        *** ROUTINE update_u_ice ***
174      !! ** Method  : Update the fluxes and recover the properties (C-grid)
175      !!-----------------------------------------------------------------------
176      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
177      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
178      LOGICAL                         , INTENT(in   ) ::   before
179      !!
180      REAL(wp) ::   zrhoy   ! local scalar
181      !!-----------------------------------------------------------------------
182      !
183      IF( before ) THEN
184         zrhoy = Agrif_Rhoy()
185         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
186         WHERE( umask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
187      ELSE
188         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
189            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
190         ENDWHERE
191      ENDIF
192      !
193   END SUBROUTINE update_u_ice
194
195
196   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
197      !!-----------------------------------------------------------------------
198      !!                    *** ROUTINE update_v_ice ***
199      !! ** Method  : Update the fluxes and recover the properties (C-grid)
200      !!-----------------------------------------------------------------------
201      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
202      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
203      LOGICAL                         , INTENT(in   ) ::   before
204      !!
205      REAL(wp) ::   zrhox   ! local scalar
206      !!-----------------------------------------------------------------------
207      !
208      IF( before ) THEN
209         zrhox = Agrif_Rhox()
210         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
211         WHERE( vmask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
212      ELSE
213         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
214            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
215         ENDWHERE
216      ENDIF
217      !
218   END SUBROUTINE update_v_ice
219
220#else
221   !!----------------------------------------------------------------------
222   !!   Empty module                                             no sea-ice
223   !!----------------------------------------------------------------------
224CONTAINS
225   SUBROUTINE agrif_ice_update_empty
226      WRITE(*,*)  'agrif_ice_update : You should not have seen this print! error?'
227   END SUBROUTINE agrif_ice_update_empty
228#endif
229
230   !!======================================================================
231END MODULE agrif_ice_update
Note: See TracBrowser for help on using the repository browser.