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/2020/dev_r12973_AGRIF_CMEMS/src/NST – NEMO

source: NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_ice_update.F90 @ 13026

Last change on this file since 13026 was 13026, checked in by rblod, 4 years ago

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