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_lim3_update.F90 in branches/2016/dev_merge_2016/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2016/dev_merge_2016/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90 @ 7421

Last change on this file since 7421 was 7421, checked in by flavoni, 7 years ago

#1811 merge dev_CNRS_MERATOR_2016 with dev_merge_2016 branch
File size: 9.1 KB
Line 
1#define TWO_WAY
2
3MODULE agrif_lim3_update
4   !!=====================================================================================
5   !!                       ***  MODULE agrif_lim3_update ***
6   !! Nesting module :  update surface ocean boundary condition over ice from a child grid
7   !! Sea-Ice model  :  LIM 3.6 Sea ice model time-stepping
8   !!=====================================================================================
9   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
10   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
11   !!            3.6   !  05-2016  (C. Rousset)  Add LIM3 compatibility
12   !!----------------------------------------------------------------------
13#if defined key_agrif && defined key_lim3
14   !!----------------------------------------------------------------------
15   !!   'key_lim3'  :                                 LIM 3.6 sea-ice model
16   !!   'key_agrif' :                                 AGRIF library
17   !!----------------------------------------------------------------------
18   !!   agrif_update_lim3  : update sea-ice on boundaries or total
19   !!                        child domain for velocities and ice properties
20   !!   update_tra_ice     : sea-ice properties
21   !!   update_u_ice       : zonal      ice velocity
22   !!   update_v_ice       : meridional ice velocity
23   !!----------------------------------------------------------------------
24   USE dom_oce
25   USE sbc_oce
26   USE agrif_oce
27   USE ice
28   USE agrif_ice 
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC agrif_update_lim3
34
35   !!----------------------------------------------------------------------
36   !! NEMO/NST 3.6 , LOCEAN-IPSL (2016)
37   !! $Id: agrif_lim3_update.F90 6204 2016-01-04 13:47:06Z cetlod $
38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE agrif_update_lim3( kt )
44      !!----------------------------------------------------------------------
45      !!                     *** ROUTINE agrif_update_lim3 ***
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      INTEGER, INTENT(in) :: kt
51      !!
52      !!----------------------------------------------------------------------
53      !
54!      IF( ( MOD( kt-nit000, Agrif_irhot() * Agrif_Parent(nn_fsbc) ) /=0 ) .AND. (kt /= 0) ) THEN
55!         PRINT *, 'clem NOT udpate, kt=',kt,Agrif_NbStepint()
56!      ELSE
57!         PRINT *, 'clem     UPDATE, kt=',kt,Agrif_NbStepint()
58!      ENDIF
59
60      !! clem: I think the update should take place each time the ocean sees the surface forcings (but maybe I am wrong and we should update every rhot time steps)
61      IF( ( MOD( kt-nit000, Agrif_irhot() * Agrif_Parent(nn_fsbc) ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement
62                                                                                                   ! i.e. update only at the parent time step
63      !! clem: this condition is clearly wrong if nn_fsbc/=1 (==> Agrif_NbStepint /= (Agrif_irhot()-1) all the time)
64      !!IF( ( Agrif_NbStepint() .NE. (Agrif_irhot()-1) ) .AND. (kt /= 0) )  RETURN
65     
66      Agrif_UseSpecialValueInUpdate = .TRUE.
67      Agrif_SpecialValueFineGrid = -9999.
68# if defined TWO_WAY
69      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
70                                                ! nbcline is incremented (+1) at the end of each parent time step from 0 (1st time step)
71         CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
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                                      ! update only the boundaries defined par locupdate
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      ENDIF
79# endif
80      Agrif_UseSpecialValueInUpdate = .FALSE.
81      !
82   END SUBROUTINE agrif_update_lim3
83
84
85   !!------------------
86   !! Local subroutines
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  :: jk, jl, jm
99      !!-----------------------------------------------------------------------
100      ! clem: it is ok not to multiply by e1 e2 since we conserve tracers here (cf ce qui est fait dans opa).
101      IF( before ) THEN
102         jm = 1
103         DO jl = 1, jpl
104            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
105            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1
106            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1
107            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1
108            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1
109            DO jk = 1, nlay_s
110               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
111            ENDDO
112            DO jk = 1, nlay_i
113               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
114            ENDDO
115         ENDDO
116
117         DO jk = k1, k2
118            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
119         ENDDO
120                 
121      ELSE
122         jm = 1
123         DO jl = 1, jpl
124            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
125            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
126            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
127            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
128            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
129            DO jk = 1, nlay_s
130               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
131            ENDDO
132            DO jk = 1, nlay_i
133               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1
134            ENDDO
135         ENDDO
136
137      ENDIF
138      !
139   END SUBROUTINE update_tra_ice
140
141
142   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
143      !!-----------------------------------------------------------------------
144      !!                        *** ROUTINE update_u_ice ***
145      !! ** Method  : Update the fluxes and recover the properties (C-grid)
146      !!-----------------------------------------------------------------------
147      INTEGER , INTENT(in) :: i1, i2, j1, j2
148      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
149      LOGICAL , INTENT(in) :: before
150      !!
151      REAL(wp) :: zrhoy
152      !!-----------------------------------------------------------------------
153      !
154      IF( before ) THEN
155         zrhoy = Agrif_Rhoy()
156         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
157         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
158      ELSE
159         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
160      ENDIF
161      !
162   END SUBROUTINE update_u_ice
163
164
165   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
166      !!-----------------------------------------------------------------------
167      !!                    *** ROUTINE update_v_ice ***
168      !! ** Method  : Update the fluxes and recover the properties (C-grid)
169      !!-----------------------------------------------------------------------
170      INTEGER , INTENT(in) :: i1,i2,j1,j2
171      REAL(wp), DIMENSION(i1:i2,j1:j2),  INTENT(inout) :: ptab
172      LOGICAL , INTENT(in) :: before
173      !!
174      REAL(wp) :: zrhox
175      !!-----------------------------------------------------------------------
176      !
177      IF( before ) THEN
178         zrhox = Agrif_Rhox()
179         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
180         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999.
181      ELSE
182         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
183      ENDIF
184      !
185   END SUBROUTINE update_v_ice
186
187#else
188CONTAINS
189   SUBROUTINE agrif_lim3_update_empty
190      !!---------------------------------------------
191      !!   *** ROUTINE agrif_lim3_update_empty ***
192      !!---------------------------------------------
193      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?'
194   END SUBROUTINE agrif_lim3_update_empty
195#endif
196END MODULE agrif_lim3_update
Note: See TracBrowser for help on using the repository browser.