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_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/NST – NEMO

source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/NST/agrif_ice_update.F90 @ 12749

Last change on this file since 12749 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
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# if ! defined DECAL_FEEDBACK
69      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
70      CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
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
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    )
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.