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 @ 9780

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

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