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/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90 @ 7953

Last change on this file since 7953 was 7953, checked in by gm, 7 years ago

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_...
File size: 9.4 KB
RevLine 
[7309]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
[7953]33   PUBLIC   agrif_update_lim3   ! called by ????
[7309]34
35   !!----------------------------------------------------------------------
[7953]36   !! NEMO/NST 4.0 , LOCEAN-IPSL (2017)
[7309]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   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE agrif_update_lim3( kt )
43      !!----------------------------------------------------------------------
44      !!                     *** ROUTINE agrif_update_lim3 ***
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      INTEGER, INTENT(in) :: kt
50      !!----------------------------------------------------------------------
51      !
[7761]52      !! clem: I think the update should take place each time the ocean sees the surface forcings
53      !!       (but maybe I am wrong and we should update every rhot time steps)
54      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement
55                                                                                                                           ! i.e. update only at the parent time step
[7309]56      Agrif_UseSpecialValueInUpdate = .TRUE.
[7953]57      Agrif_SpecialValueFineGrid    = -9999.
[7309]58# if defined TWO_WAY
59      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps
60                                                ! nbcline is incremented (+1) at the end of each parent time step from 0 (1st time step)
61         CALL Agrif_Update_Variable( tra_ice_id , procname = update_tra_ice  )
62         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    )
63         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    )
64      ELSE                                      ! update only the boundaries defined par locupdate
65         CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  )
66         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    )
67         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    )
68      ENDIF
69# endif
70      Agrif_UseSpecialValueInUpdate = .FALSE.
71      !
72   END SUBROUTINE agrif_update_lim3
73
74
75   SUBROUTINE update_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before )
76      !!-----------------------------------------------------------------------
77      !!                        *** ROUTINE update_tra_ice ***
78      !! ** Method  : Compute the mass properties on the fine grid and recover
79      !!              the properties per mass on the coarse grid
80      !!-----------------------------------------------------------------------
[7953]81      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
82      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
83      LOGICAL                               , INTENT(in   ) ::   before
[7309]84      !!
85      INTEGER  :: jk, jl, jm
86      !!-----------------------------------------------------------------------
[7761]87      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean).
[7309]88      IF( before ) THEN
89         jm = 1
90         DO jl = 1, jpl
[7953]91            ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
92            ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
93            ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl)   ;   jm = jm + 1
94            ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl)   ;   jm = jm + 1
95            ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl)   ;   jm = jm + 1
[7309]96            DO jk = 1, nlay_s
[7953]97               ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
98            END DO
[7309]99            DO jk = 1, nlay_i
[7953]100               ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
101            END DO
102         END DO
[7309]103
104         DO jk = k1, k2
105            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999.
[7953]106         END DO
107         !       
[7309]108      ELSE
109         jm = 1
110         DO jl = 1, jpl
[7953]111            a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
112            v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
113            v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
114            smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
115            oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
[7309]116            DO jk = 1, nlay_s
[7953]117               e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
[7309]118            ENDDO
119            DO jk = 1, nlay_i
[7953]120               e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1)   ;   jm = jm + 1
121            END DO
122         END DO
[7309]123
[7761]124         ! integrated values
125         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 )
126         vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 )
127         at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 )
128         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
129         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 )
130         
[7309]131      ENDIF
132      !
133   END SUBROUTINE update_tra_ice
134
135
136   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
137      !!-----------------------------------------------------------------------
138      !!                        *** ROUTINE update_u_ice ***
139      !! ** Method  : Update the fluxes and recover the properties (C-grid)
140      !!-----------------------------------------------------------------------
[7953]141      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
142      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
143      LOGICAL                         , INTENT(in   ) ::   before
[7309]144      !!
[7953]145      REAL(wp) ::   zrhoy   ! local scalar
[7309]146      !!-----------------------------------------------------------------------
147      !
148      IF( before ) THEN
149         zrhoy = Agrif_Rhoy()
150         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
[7953]151         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999.
[7309]152      ELSE
153         u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
154      ENDIF
155      !
156   END SUBROUTINE update_u_ice
157
158
159   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
160      !!-----------------------------------------------------------------------
161      !!                    *** ROUTINE update_v_ice ***
162      !! ** Method  : Update the fluxes and recover the properties (C-grid)
163      !!-----------------------------------------------------------------------
[7953]164      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
165      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
166      LOGICAL                         , INTENT(in   ) ::   before
[7309]167      !!
[7953]168      REAL(wp) ::   zrhox   ! local scalar
[7309]169      !!-----------------------------------------------------------------------
170      !
171      IF( before ) THEN
172         zrhox = Agrif_Rhox()
173         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
[7953]174         WHERE( vmask(i1:i2,j1:j2,1) == 0. )   ptab(:,:) = -9999.
[7309]175      ELSE
176         v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
177      ENDIF
178      !
179   END SUBROUTINE update_v_ice
180
181#else
[7953]182   !!----------------------------------------------------------------------
183   !!   Empty module                                             no sea-ice
184   !!----------------------------------------------------------------------
[7309]185CONTAINS
186   SUBROUTINE agrif_lim3_update_empty
187      WRITE(*,*)  'agrif_lim3_update : You should not have seen this print! error?'
188   END SUBROUTINE agrif_lim3_update_empty
189#endif
[7953]190
191   !!======================================================================
[7309]192END MODULE agrif_lim3_update
Note: See TracBrowser for help on using the repository browser.