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

Last change on this file since 9596 was 9596, checked in by nicolasmartin, 6 years ago

Reorganisation plan for NEMO repository: preliminary implementation of the new trunk structure (ref #2015)

  • Deletion of useless 1st level, add new explicit names for folders
  • Extract dev tools (SETTE and Trusting) to /utils/CI
  • Extract figures folder from documentation to /utils/figures
  • Extrac TEST_CASES to /utils/test_cases
  • Move ./TOOLS/COMPILE to ./mk
  • Add few wiki files at the root: README, INSTALL and LICENSE with full text of CeCILL v2.0
  • Style: uppercase for wiki files, lowercase for folder names

Additionally, inclusion of routines renaming in NST: agrif_si3 -> agrif_ice
File size: 9.8 KB
RevLine 
[7309]1#define TWO_WAY
[9482]2!!#undef TWO_WAY
[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   !! Sea-Ice model  :  LIM 3.6 Sea ice model time-stepping
9   !!=====================================================================================
10   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
11   !!            3.4   !  08-2012  (R. Benshila, C. Herbaut) update and EVP
12   !!            3.6   !  05-2016  (C. Rousset)  Add LIM3 compatibility
13   !!----------------------------------------------------------------------
[9570]14#if defined key_agrif && defined key_si3
[7309]15   !!----------------------------------------------------------------------
[9570]16   !!   'key_si3'  :                                 LIM 3.6 sea-ice model
[7309]17   !!   'key_agrif' :                                 AGRIF library
18   !!----------------------------------------------------------------------
[9570]19   !!   agrif_update_si3  : update sea-ice on boundaries or total
[7309]20   !!                        child domain for velocities and ice properties
21   !!   update_tra_ice     : sea-ice properties
22   !!   update_u_ice       : zonal      ice velocity
23   !!   update_v_ice       : meridional ice velocity
24   !!----------------------------------------------------------------------
25   USE dom_oce
26   USE sbc_oce
27   USE agrif_oce
28   USE ice
29   USE agrif_ice 
[9454]30   USE phycst , ONLY: rt0
[7309]31
32   IMPLICIT NONE
33   PRIVATE
34
[9570]35   PUBLIC   agrif_update_si3   ! called by agrif_user.F90 and icestp.F90
[7309]36
37   !!----------------------------------------------------------------------
[9019]38   !! NEMO/NST 4.0 , LOCEAN-IPSL (2017)
[9596]39   !! $Id: agrif_ice_update.F90 6204 2016-01-04 13:47:06Z cetlod $
[7309]40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
[9570]44   SUBROUTINE agrif_update_si3( kt )
[7309]45      !!----------------------------------------------------------------------
[9570]46      !!                     *** ROUTINE agrif_update_si3 ***
[7309]47      !! ** Method  :   Call the hydrostaticupdate pressure at the boundary or the entire domain
48      !!
49      !! ** Action : - Update (u_ice,v_ice) and ice tracers
50      !!----------------------------------------------------------------------
51      INTEGER, INTENT(in) :: kt
52      !!----------------------------------------------------------------------
53      !
[9482]54      IF( Agrif_Root() .OR. nn_ice == 0 ) RETURN   ! do not update if inside Parent Grid or if child domain does not have ice
[9019]55      !
[9482]56      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
57      !
[9019]58      Agrif_SpecialValueFineGrid    = -9999.
[7309]59      Agrif_UseSpecialValueInUpdate = .TRUE.
60# if defined TWO_WAY
[9031]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
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    )
[7309]68# endif
[9019]69      Agrif_SpecialValueFineGrid    = 0.
[7309]70      Agrif_UseSpecialValueInUpdate = .FALSE.
71      !
[9570]72   END SUBROUTINE agrif_update_si3
[7309]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      !!-----------------------------------------------------------------------
[9019]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      !!
[9019]85      INTEGER  :: ji, jj, jk, jl, jm
[7309]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
[9019]91            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl)
92            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl)
93            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl)
94            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl)
[9167]95            ptab(i1:i2,j1:j2,jm+4) = oa_i(i1:i2,j1:j2,jl)
96            ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl)
97            ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl)
98            ptab(i1:i2,j1:j2,jm+7) = t_su(i1:i2,j1:j2,jl)
99            jm = jm + 8
[7309]100            DO jk = 1, nlay_s
[9019]101               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
102            END DO
[7309]103            DO jk = 1, nlay_i
[9019]104               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
105            END DO
106         END DO
107         !
[7309]108         DO jk = k1, k2
[9019]109            WHERE( tmask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 
110         END DO
111         !
[7309]112      ELSE
[9019]113         !
[7309]114         jm = 1
115         DO jl = 1, jpl
[9019]116            !
117            DO jj = j1, j2
118               DO ji = i1, i2
119                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN
120                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
121                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
122                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
123                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
124                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
[9167]125                     a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1)
126                     v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1)
127                     t_su(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1)
[9019]128                  ENDIF
129               END DO
130            END DO
[9167]131            jm = jm + 8
[9019]132            !
[7309]133            DO jk = 1, nlay_s
[9019]134               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
135                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
136               ENDWHERE
137               jm = jm + 1
138            END DO
139            !
[7309]140            DO jk = 1, nlay_i
[9019]141               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid )
142                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
143               ENDWHERE
144               jm = jm + 1
145            END DO
146            !
147         END DO
148         !
[9454]149         DO jl = 1, jpl
150            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
151         END DO
[7761]152         
[7309]153      ENDIF
154      !
155   END SUBROUTINE update_tra_ice
156
157
158   SUBROUTINE update_u_ice( ptab, i1, i2, j1, j2, before )
159      !!-----------------------------------------------------------------------
160      !!                        *** ROUTINE update_u_ice ***
161      !! ** Method  : Update the fluxes and recover the properties (C-grid)
162      !!-----------------------------------------------------------------------
[9019]163      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
164      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
165      LOGICAL                         , INTENT(in   ) ::   before
[7309]166      !!
[9019]167      REAL(wp) ::   zrhoy   ! local scalar
[7309]168      !!-----------------------------------------------------------------------
169      !
170      IF( before ) THEN
171         zrhoy = Agrif_Rhoy()
172         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy
[9019]173         WHERE( umask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
[7309]174      ELSE
[9019]175         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
176            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1)
177         ENDWHERE
[7309]178      ENDIF
179      !
180   END SUBROUTINE update_u_ice
181
182
183   SUBROUTINE update_v_ice( ptab, i1, i2, j1, j2, before )
184      !!-----------------------------------------------------------------------
185      !!                    *** ROUTINE update_v_ice ***
186      !! ** Method  : Update the fluxes and recover the properties (C-grid)
187      !!-----------------------------------------------------------------------
[9019]188      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
189      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
190      LOGICAL                         , INTENT(in   ) ::   before
[7309]191      !!
[9019]192      REAL(wp) ::   zrhox   ! local scalar
[7309]193      !!-----------------------------------------------------------------------
194      !
195      IF( before ) THEN
196         zrhox = Agrif_Rhox()
197         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox
[9019]198         WHERE( vmask(i1:i2,j1:j2,1) == 0._wp )   ptab(:,:) = Agrif_SpecialValueFineGrid
[7309]199      ELSE
[9019]200         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid )
201            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1)
202         ENDWHERE
[7309]203      ENDIF
204      !
205   END SUBROUTINE update_v_ice
206
207#else
[9019]208   !!----------------------------------------------------------------------
209   !!   Empty module                                             no sea-ice
210   !!----------------------------------------------------------------------
[7309]211CONTAINS
[9596]212   SUBROUTINE agrif_ice_update_empty
213      WRITE(*,*)  'agrif_ice_update : You should not have seen this print! error?'
214   END SUBROUTINE agrif_ice_update_empty
[7309]215#endif
[9019]216
217   !!======================================================================
[9596]218END MODULE agrif_ice_update
Note: See TracBrowser for help on using the repository browser.