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

Last change on this file since 12489 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 10.6 KB
RevLine 
[9761]1#undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/
[7309]2
[9596]3MODULE agrif_ice_update
[7309]4   !!=====================================================================================
[9596]5   !!                       ***  MODULE agrif_ice_update ***
[7309]6   !! Nesting module :  update surface ocean boundary condition over ice from a child grid
7   !!=====================================================================================
[9656]8   !! History :  2.0   !  04-2008  (F. Dupont)               initial version
[7309]9   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
[9656]10   !!            4.0   !  2018     (C. Rousset)              SI3 compatibility
[7309]11   !!----------------------------------------------------------------------
[9570]12#if defined key_agrif && defined key_si3
[7309]13   !!----------------------------------------------------------------------
[9656]14   !!   'key_si3'  :                                      SI3 sea-ice model
15   !!   'key_agrif' :                                     AGRIF library
[7309]16   !!----------------------------------------------------------------------
[9610]17   !!   agrif_update_ice  : update sea-ice on boundaries or total
[7309]18   !!                        child domain for velocities and ice properties
[9656]19   !!   update_tra_ice    : sea-ice properties
20   !!   update_u_ice      : zonal      ice velocity
21   !!   update_v_ice      : meridional ice velocity
[7309]22   !!----------------------------------------------------------------------
23   USE dom_oce
24   USE sbc_oce
25   USE agrif_oce
26   USE ice
27   USE agrif_ice 
[9454]28   USE phycst , ONLY: rt0
[7309]29
30   IMPLICIT NONE
31   PRIVATE
32
[9610]33   PUBLIC   agrif_update_ice   ! called by agrif_user.F90 and icestp.F90
[7309]34
35   !!----------------------------------------------------------------------
[9598]36   !! NEMO/NST 4.0 , NEMO Consortium (2018)
[10069]37   !! $Id$
[10068]38   !! Software governed by the CeCILL license (see ./LICENSE)
[7309]39   !!----------------------------------------------------------------------
40CONTAINS
41
[9780]42   SUBROUTINE agrif_update_ice( )
[7309]43      !!----------------------------------------------------------------------
[9610]44      !!                     *** ROUTINE agrif_update_ice ***
[7309]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      !
[9482]50      IF( Agrif_Root() .OR. nn_ice == 0 ) RETURN   ! do not update if inside Parent Grid or if child domain does not have ice
[9019]51      !
[9780]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
[9785]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()
[9780]58      !
[9785]59      !
[9019]60      Agrif_SpecialValueFineGrid    = -9999.
[7309]61      Agrif_UseSpecialValueInUpdate = .TRUE.
[9761]62
63# if ! defined DECAL_FEEDBACK
[9031]64      CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
[9761]65#else
66      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/1,0/), procname = update_tra_ice  )
67#endif
68# if ! defined DECAL_FEEDBACK
[9031]69      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
70      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
[9761]71#else
72      CALL Agrif_Update_Variable( u_ice_id   , locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname=update_u_ice) 
73      CALL Agrif_Update_Variable( v_ice_id   , locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname=update_v_ice)
74#endif
[9031]75!      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  )
76!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
77!      CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
[9019]78      Agrif_SpecialValueFineGrid    = 0.
[7309]79      Agrif_UseSpecialValueInUpdate = .FALSE.
80      !
[9610]81   END SUBROUTINE agrif_update_ice
[7309]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      !!-----------------------------------------------------------------------
[9019]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
[7309]93      !!
[9019]94      INTEGER  :: ji, jj, jk, jl, jm
[7309]95      !!-----------------------------------------------------------------------
[7761]96      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
[7309]97      IF( before ) THEN
98         jm = 1
99         DO jl = 1, jpl
[9019]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)
[9167]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
[7309]109            DO jk = 1, nlay_s
[9019]110               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
111            END DO
[7309]112            DO jk = 1, nlay_i
[9019]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         !
[7309]117         DO jk = k1, k2
[9019]118            WHERE( tmask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
119         END DO
120         !
[7309]121      ELSE
[9019]122         !
[7309]123         jm = 1
124         DO jl = 1, jpl
[9019]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)
[9167]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)
[9019]137                  ENDIF
138               END DO
139            END DO
[9167]140            jm = jm + 8
[9019]141            !
[7309]142            DO jk = 1, nlay_s
[9019]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            !
[7309]149            DO jk = 1, nlay_i
[9019]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         !
[9454]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
[7761]161         
[7309]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      !!-----------------------------------------------------------------------
[9019]172      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
173      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
174      LOGICAL                         , INTENT(in   ) ::   before
[7309]175      !!
[9019]176      REAL(wp) ::   zrhoy   ! local scalar
[7309]177      !!-----------------------------------------------------------------------
178      !
179      IF( before ) THEN
180         zrhoy = Agrif_Rhoy()
181         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
[9019]182         WHERE( umask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
[7309]183      ELSE
[9019]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
[7309]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      !!-----------------------------------------------------------------------
[9019]197      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
198      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
199      LOGICAL                         , INTENT(in   ) ::   before
[7309]200      !!
[9019]201      REAL(wp) ::   zrhox   ! local scalar
[7309]202      !!-----------------------------------------------------------------------
203      !
204      IF( before ) THEN
205         zrhox = Agrif_Rhox()
206         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
[9019]207         WHERE( vmask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
[7309]208      ELSE
[9019]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
[7309]212      ENDIF
213      !
214   END SUBROUTINE update_v_ice
215
216#else
[9019]217   !!----------------------------------------------------------------------
218   !!   Empty module                                             no sea-ice
219   !!----------------------------------------------------------------------
[7309]220CONTAINS
[9596]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
[7309]224#endif
[9019]225
226   !!======================================================================
[9596]227END MODULE agrif_ice_update
Note: See TracBrowser for help on using the repository browser.