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.
iceupdate.F90 in NEMO/branches/UKMO/NEMO_4.0_GO8_coupled_iodef/src/ICE – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_GO8_coupled_iodef/src/ICE/iceupdate.F90 @ 11367

Last change on this file since 11367 was 11367, checked in by dancopsey, 5 years ago

More print statements including fix
File size: 32.4 KB
Line 
1MODULE iceupdate
2   !!======================================================================
3   !!                       ***  MODULE iceupdate   ***
4   !!  Sea-ice :   computation of the flux at the sea ice/ocean interface
5   !!======================================================================
6   !! History :  4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
7   !!----------------------------------------------------------------------
8#if defined key_si3
9   !!----------------------------------------------------------------------
10   !!   'key_si3'                                       SI3 sea-ice model
11   !!----------------------------------------------------------------------
12   !!   ice_update_alloc : allocate the iceupdate arrays
13   !!   ice_update_init  : initialisation
14   !!   ice_update_flx   : updates mass, heat and salt fluxes at the ocean surface
15   !!   ice_update_tau   : update i- and j-stresses, and its modulus at the ocean surface
16   !!----------------------------------------------------------------------
17   USE oce     , ONLY : sshn, sshb
18   USE phycst         ! physical constants
19   USE dom_oce        ! ocean domain
20   USE ice            ! sea-ice: variables
21   USE sbc_ice        ! Surface boundary condition: ice   fields
22   USE sbc_oce        ! Surface boundary condition: ocean fields
23   USE sbccpl         ! Surface boundary condition: coupled interface
24   USE icealb         ! sea-ice: albedo parameters
25   USE traqsr         ! add penetration of solar flux in the calculation of heat budget
26   USE icectl         ! sea-ice: control prints
27   USE bdy_oce , ONLY : ln_bdy
28   !
29   USE in_out_manager ! I/O manager
30   USE iom            ! I/O manager library
31   USE lib_mpp        ! MPP library
32   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
33   USE lbclnk         ! lateral boundary conditions (or mpp links)
34   USE timing         ! Timing
35
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC   ice_update_init   ! called by ice_init
40   PUBLIC   ice_update_flx    ! called by ice_stp
41   PUBLIC   ice_update_tau    ! called by ice_stp
42
43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2]
44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean velocity   [m/s]
45
46   !! * Substitutions
47#  include "vectopt_loop_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
50   !! $Id$
51   !! Software governed by the CeCILL license (see ./LICENSE)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   INTEGER FUNCTION ice_update_alloc()
56      !!-------------------------------------------------------------------
57      !!             ***  ROUTINE ice_update_alloc ***
58      !!-------------------------------------------------------------------
59      ALLOCATE( utau_oce(jpi,jpj), vtau_oce(jpi,jpj), tmod_io(jpi,jpj), STAT=ice_update_alloc )
60      !
61      CALL mpp_sum( 'iceupdate', ice_update_alloc )
62      IF( ice_update_alloc /= 0 )   CALL ctl_stop( 'STOP', 'ice_update_alloc: failed to allocate arrays' )
63      !
64   END FUNCTION ice_update_alloc
65
66
67   SUBROUTINE ice_update_flx( kt )
68      !!-------------------------------------------------------------------
69      !!                ***  ROUTINE ice_update_flx ***
70      !! 
71      !! ** Purpose :   Update the surface ocean boundary condition for heat
72      !!                salt and mass over areas where sea-ice is non-zero
73      !!         
74      !! ** Action  : - computes the heat and freshwater/salt fluxes
75      !!                at the ice-ocean interface.
76      !!              - Update the ocean sbc
77      !!     
78      !! ** Outputs : - qsr     : sea heat flux:     solar
79      !!              - qns     : sea heat flux: non solar
80      !!              - emp     : freshwater budget: volume flux
81      !!              - sfx     : salt flux
82      !!              - fr_i    : ice fraction
83      !!              - tn_ice  : sea-ice surface temperature
84      !!              - alb_ice : sea-ice albedo (recomputed only for coupled mode)
85      !!
86      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
87      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
88      !!              These refs are now obsolete since everything has been revised
89      !!              The ref should be Rousset et al., 2015
90      !!---------------------------------------------------------------------
91      INTEGER, INTENT(in) ::   kt   ! number of iteration
92      !
93      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices
94      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2)
95      REAL(wp) ::   zqsr             ! New solar flux received by the ocean
96      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  ! 2D workspace
97      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace
98      INTEGER, DIMENSION(2)  ::   imax                  ! min/max loc indices
99
100      !!---------------------------------------------------------------------
101      IF( ln_timing )   CALL timing_start('ice_update')
102
103      IF( kt == nit000 .AND. lwp ) THEN
104         WRITE(numout,*)
105         WRITE(numout,*)'ice_update_flx: update fluxes (mass, salt and heat) at the ice-ocean interface'
106         WRITE(numout,*)'~~~~~~~~~~~~~~'
107      ENDIF
108
109      ! --- case we bypass ice thermodynamics --- !
110      IF( .NOT. ln_icethd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere
111         qt_atm_oi  (:,:)   = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
112         qt_oce_ai  (:,:)   = ( 1._wp - at_i_b(:,:) ) *   qns_oce(:,:)                  + qemp_oce(:,:)
113         emp_ice    (:,:)   = 0._wp
114         qemp_ice   (:,:)   = 0._wp
115         qevap_ice  (:,:,:) = 0._wp
116      ENDIF
117
118      IF(narea == 419) THEN
119         ! emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)
120         ! wfx_ice = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
121         !      &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
122         ! wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
123         WRITE(9419,*) 'max emp_oce iceupdate before loop = ',MAXVAL(  ABS( emp_oce(:,:) )  )
124         WRITE(9419,*) 'max wfx_err_sub iceupdate before loop = ',MAXVAL(  ABS( wfx_err_sub(:,:) )  )
125         WRITE(9419,*) 'max wfx_bog iceupdate before loop = ',MAXVAL(  ABS( wfx_bog(:,:) )  )
126         WRITE(9419,*) 'max wfx_bom iceupdate before loop = ',MAXVAL(  ABS( wfx_bom(:,:) )  )
127         WRITE(9419,*) 'max wfx_sum iceupdate before loop = ',MAXVAL(  ABS( wfx_sum(:,:) )  )
128         WRITE(9419,*) 'max wfx_sni iceupdate before loop = ',MAXVAL(  ABS( wfx_sni(:,:) )  )
129         WRITE(9419,*) 'max wfx_opw iceupdate before loop = ',MAXVAL(  ABS( wfx_opw(:,:) )  )
130         WRITE(9419,*) 'max wfx_dyn iceupdate before loop = ',MAXVAL(  ABS( wfx_dyn(:,:) )  )
131         WRITE(9419,*) 'max wfx_res iceupdate before loop = ',MAXVAL(  ABS( wfx_res(:,:) )  )
132         WRITE(9419,*) 'max wfx_lam iceupdate before loop = ',MAXVAL(  ABS( wfx_lam(:,:) )  )
133         WRITE(9419,*) 'max wfx_pnd iceupdate before loop = ',MAXVAL(  ABS( wfx_pnd(:,:) )  )
134         WRITE(9419,*) 'max wfx_snw_sni iceupdate before loop = ',MAXVAL(  ABS( wfx_snw_sni(:,:) )  )
135         WRITE(9419,*) 'max wfx_snw_dyn iceupdate before loop = ',MAXVAL(  ABS( wfx_snw_dyn(:,:) )  )
136         WRITE(9419,*) 'max wfx_snw_sum iceupdate before loop = ',MAXVAL(  ABS( wfx_snw_sum(:,:) )  )
137         imax(:) = MAXLOC( ABS( wfx_snw_sum(:,:) ) )
138         WRITE(9419,*) 'wfx_snw_sum at location = ',imax
139         WRITE(9419,*) 'wfx_snw_sum(imax) = ',wfx_snw_sum(imax(1),imax(2))
140      ENDIF
141
142      IF(narea == 68) THEN
143         ! emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)
144         ! wfx_ice = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
145         !      &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
146         ! wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
147         WRITE(968,*) 'sum wfx_opw iceupdate before loop = ',SUM( wfx_opw )
148         WRITE(968,*) 'max emp_oce iceupdate before loop = ',MAXVAL(  ABS( emp_oce(:,:) )  )
149         WRITE(968,*) 'max wfx_err_sub iceupdate before loop = ',MAXVAL(  ABS( wfx_err_sub(:,:) )  )
150         WRITE(968,*) 'max wfx_bog iceupdate before loop = ',MAXVAL(  ABS( wfx_bog(:,:) )  )
151         WRITE(968,*) 'max wfx_bom iceupdate before loop = ',MAXVAL(  ABS( wfx_bom(:,:) )  )
152         WRITE(968,*) 'max wfx_sum iceupdate before loop = ',MAXVAL(  ABS( wfx_sum(:,:) )  )
153         WRITE(968,*) 'max wfx_sni iceupdate before loop = ',MAXVAL(  ABS( wfx_sni(:,:) )  )
154         WRITE(968,*) 'max wfx_opw iceupdate before loop = ',MAXVAL(  ABS( wfx_opw(:,:) )  )
155         WRITE(968,*) 'max wfx_dyn iceupdate before loop = ',MAXVAL(  ABS( wfx_dyn(:,:) )  )
156         WRITE(968,*) 'max wfx_res iceupdate before loop = ',MAXVAL(  ABS( wfx_res(:,:) )  )
157         WRITE(968,*) 'max wfx_lam iceupdate before loop = ',MAXVAL(  ABS( wfx_lam(:,:) )  )
158         WRITE(968,*) 'max wfx_pnd iceupdate before loop = ',MAXVAL(  ABS( wfx_pnd(:,:) )  )
159         WRITE(968,*) 'max wfx_snw_sni iceupdate before loop = ',MAXVAL(  ABS( wfx_snw_sni(:,:) )  )
160         WRITE(968,*) 'max wfx_snw_dyn iceupdate before loop = ',MAXVAL(  ABS( wfx_snw_dyn(:,:) )  )
161         WRITE(968,*) 'max wfx_snw_sum iceupdate before loop = ',MAXVAL(  ABS( wfx_snw_sum(:,:) )  )
162         imax(:) = MAXLOC( ABS( wfx_snw_sum(:,:) ) )
163         WRITE(968,*) 'wfx_snw_sum at location = ',imax
164         WRITE(968,*) 'wfx_snw_sum(imax) = ',wfx_snw_sum(imax(1),imax(2))
165      ENDIF
166     
167      DO jj = 1, jpj
168         DO ji = 1, jpi
169
170            ! Solar heat flux reaching the ocean = zqsr (W.m-2)
171            !---------------------------------------------------
172            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) )
173
174            ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)
175            !---------------------------------------------------
176            zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)
177            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr
178
179            ! Add the residual from heat diffusion equation and sublimation (W.m-2)
180            !----------------------------------------------------------------------
181            qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   &
182               &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )
183
184            ! New qsr and qns used to compute the oceanic heat flux at the next time step
185            !----------------------------------------------------------------------------
186            qsr(ji,jj) = zqsr                                     
187            qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr             
188
189            ! Mass flux at the atm. surface       
190            !-----------------------------------
191            wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
192
193            ! Mass flux at the ocean surface     
194            !------------------------------------
195            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
196            !  -------------------------------------------------------------------------------------
197            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
198            !  Thus  FW  flux  =  External ( E-P+snow melt)
199            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
200            !                     Associated to Ice formation AND Ice melting
201            !                     Even if i see Ice melting as a FW and SALT flux
202            !       
203            ! mass flux from ice/ocean
204            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
205               &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)
206
207            ! add the snow melt water to snow mass flux to the ocean
208            wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
209
210            ! mass flux at the ocean/ice interface
211            fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model
212            emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
213
214
215            ! Salt flux at the ocean surface     
216            !------------------------------------------
217            sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
218               &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
219           
220            ! Mass of snow and ice per unit area   
221            !----------------------------------------
222            snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
223            !                                               ! new mass per unit area
224            snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  ) 
225            !                                               ! time evolution of snow+ice mass
226            snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice
227           
228         END DO
229      END DO
230
231      IF(narea == 419) THEN
232         WRITE(9419,*) 'max emp iceupdate after loop = ',MAXVAL(  ABS( emp(:,:) )  )
233         imax(:) = MAXLOC( ABS( emp(:,:) ) )
234         WRITE(9419,*) 'at location = ',imax
235      ENDIF
236
237      ! Storing the transmitted variables
238      !----------------------------------
239      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction           
240      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                     
241
242      ! Snow/ice albedo (only if sent to coupler, useless in forced mode)
243      !------------------------------------------------------------------
244      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos
245      !
246      alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
247      !
248      IF( lrst_ice ) THEN                       !* write snwice_mass fields in the restart file
249         CALL update_rst( 'WRITE', kt )
250      ENDIF
251      !
252      ! output all fluxes
253      !------------------
254      !
255      ! --- salt fluxes [kg/m2/s] --- !
256      !                           ! sfxice =  sfxbog + sfxbom + sfxsum + sfxsni + sfxopw + sfxres + sfxdyn + sfxbri + sfxsub + sfxlam
257      IF( iom_use('sfxice'  ) )   CALL iom_put( "sfxice", sfx     * 1.e-03 )   ! salt flux from total ice growth/melt
258      IF( iom_use('sfxbog'  ) )   CALL iom_put( "sfxbog", sfx_bog * 1.e-03 )   ! salt flux from bottom growth
259      IF( iom_use('sfxbom'  ) )   CALL iom_put( "sfxbom", sfx_bom * 1.e-03 )   ! salt flux from bottom melting
260      IF( iom_use('sfxsum'  ) )   CALL iom_put( "sfxsum", sfx_sum * 1.e-03 )   ! salt flux from surface melting
261      IF( iom_use('sfxlam'  ) )   CALL iom_put( "sfxlam", sfx_lam * 1.e-03 )   ! salt flux from lateral melting
262      IF( iom_use('sfxsni'  ) )   CALL iom_put( "sfxsni", sfx_sni * 1.e-03 )   ! salt flux from snow ice formation
263      IF( iom_use('sfxopw'  ) )   CALL iom_put( "sfxopw", sfx_opw * 1.e-03 )   ! salt flux from open water formation
264      IF( iom_use('sfxdyn'  ) )   CALL iom_put( "sfxdyn", sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting
265      IF( iom_use('sfxbri'  ) )   CALL iom_put( "sfxbri", sfx_bri * 1.e-03 )   ! salt flux from brines
266      IF( iom_use('sfxres'  ) )   CALL iom_put( "sfxres", sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes
267      IF( iom_use('sfxsub'  ) )   CALL iom_put( "sfxsub", sfx_sub * 1.e-03 )   ! salt flux from sublimation
268
269      ! --- mass fluxes [kg/m2/s] --- !
270      IF( iom_use('emp_oce' ) )   CALL iom_put( "emp_oce", emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice)
271      IF( iom_use('emp_ice' ) )   CALL iom_put( "emp_ice", emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice)
272
273      !                           ! vfxice = vfxbog + vfxbom + vfxsum + vfxsni + vfxopw + vfxdyn + vfxres + vfxlam + vfxpnd
274      IF( iom_use('vfxice'  ) )   CALL iom_put( "vfxice" , wfx_ice )   ! mass flux from total ice growth/melt
275      IF( iom_use('vfxbog'  ) )   CALL iom_put( "vfxbog" , wfx_bog )   ! mass flux from bottom growth
276      IF( iom_use('vfxbom'  ) )   CALL iom_put( "vfxbom" , wfx_bom )   ! mass flux from bottom melt
277      IF( iom_use('vfxsum'  ) )   CALL iom_put( "vfxsum" , wfx_sum )   ! mass flux from surface melt
278      IF( iom_use('vfxlam'  ) )   CALL iom_put( "vfxlam" , wfx_lam )   ! mass flux from lateral melt
279      IF( iom_use('vfxsni'  ) )   CALL iom_put( "vfxsni" , wfx_sni )   ! mass flux from snow-ice formation
280      IF( iom_use('vfxopw'  ) )   CALL iom_put( "vfxopw" , wfx_opw )   ! mass flux from growth in open water
281      IF( iom_use('vfxdyn'  ) )   CALL iom_put( "vfxdyn" , wfx_dyn )   ! mass flux from dynamics (ridging)
282      IF( iom_use('vfxres'  ) )   CALL iom_put( "vfxres" , wfx_res )   ! mass flux from undiagnosed processes
283      IF( iom_use('vfxpnd'  ) )   CALL iom_put( "vfxpnd" , wfx_pnd )   ! mass flux from melt ponds
284      IF( iom_use('vfxsub'  ) )   CALL iom_put( "vfxsub" , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.)
285      IF( iom_use('vfxsub_err') ) CALL iom_put( "vfxsub_err", wfx_err_sub )   ! "excess" of sublimation sent to ocean     
286
287      IF ( iom_use( "vfxthin" ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 
288         WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog
289         ELSEWHERE                                     ; z2d = 0._wp
290         END WHERE
291         CALL iom_put( "vfxthin", wfx_opw + z2d )
292      ENDIF
293
294      !                              ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum
295      IF( iom_use('vfxsnw'     ) )   CALL iom_put( "vfxsnw"     , wfx_snw     )   ! mass flux from total snow growth/melt
296      IF( iom_use('vfxsnw_sum' ) )   CALL iom_put( "vfxsnw_sum" , wfx_snw_sum )   ! mass flux from snow melt at the surface
297      IF( iom_use('vfxsnw_sni' ) )   CALL iom_put( "vfxsnw_sni" , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation
298      IF( iom_use('vfxsnw_dyn' ) )   CALL iom_put( "vfxsnw_dyn" , wfx_snw_dyn )   ! mass flux from dynamics (ridging)
299      IF( iom_use('vfxsnw_sub' ) )   CALL iom_put( "vfxsnw_sub" , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)
300      IF( iom_use('vfxsnw_pre' ) )   CALL iom_put( "vfxsnw_pre" , wfx_spr     )   ! snow precip
301
302      ! --- heat fluxes [W/m2] --- !
303      !                              ! qt_atm_oi - qt_oce_ai = hfxdhc - ( dihctrp + dshctrp )
304      IF( iom_use('qsr_oce'    ) )   CALL iom_put( "qsr_oce"    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface
305      IF( iom_use('qns_oce'    ) )   CALL iom_put( "qns_oce"    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface
306      IF( iom_use('qsr_ice'    ) )   CALL iom_put( "qsr_ice"    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface
307      IF( iom_use('qns_ice'    ) )   CALL iom_put( "qns_ice"    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface
308      IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice
309      IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface
310      IF( iom_use('qt_oce'     ) )   CALL iom_put( "qt_oce"     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )
311      IF( iom_use('qt_ice'     ) )   CALL iom_put( "qt_ice"     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice )
312      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( "qt_oce_ai"  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)
313      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( "qt_atm_oi"  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)
314      IF( iom_use('qemp_oce'   ) )   CALL iom_put( "qemp_oce"   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean
315      IF( iom_use('qemp_ice'   ) )   CALL iom_put( "qemp_ice"   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice
316
317      ! heat fluxes from ice transformations
318      !                              ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr )
319      IF( iom_use('hfxbog'     ) )   CALL iom_put ("hfxbog"     , hfx_bog             )   ! heat flux used for ice bottom growth
320      IF( iom_use('hfxbom'     ) )   CALL iom_put ("hfxbom"     , hfx_bom             )   ! heat flux used for ice bottom melt
321      IF( iom_use('hfxsum'     ) )   CALL iom_put ("hfxsum"     , hfx_sum             )   ! heat flux used for ice surface melt
322      IF( iom_use('hfxopw'     ) )   CALL iom_put ("hfxopw"     , hfx_opw             )   ! heat flux used for ice formation in open water
323      IF( iom_use('hfxdif'     ) )   CALL iom_put ("hfxdif"     , hfx_dif             )   ! heat flux used for ice temperature change
324      IF( iom_use('hfxsnw'     ) )   CALL iom_put ("hfxsnw"     , hfx_snw             )   ! heat flux used for snow melt
325      IF( iom_use('hfxerr'     ) )   CALL iom_put ("hfxerr"     , hfx_err_dif         )   ! heat flux error after heat diffusion (included in qt_oce_ai)
326
327      ! heat fluxes associated with mass exchange (freeze/melt/precip...)
328      IF( iom_use('hfxthd'     ) )   CALL iom_put ("hfxthd"     , hfx_thd             )   ! 
329      IF( iom_use('hfxdyn'     ) )   CALL iom_put ("hfxdyn"     , hfx_dyn             )   ! 
330      IF( iom_use('hfxres'     ) )   CALL iom_put ("hfxres"     , hfx_res             )   ! 
331      IF( iom_use('hfxsub'     ) )   CALL iom_put ("hfxsub"     , hfx_sub             )   ! 
332      IF( iom_use('hfxspr'     ) )   CALL iom_put ("hfxspr"     , hfx_spr             )   ! Heat flux from snow precip heat content
333
334      ! other heat fluxes
335      IF( iom_use('hfxsensib'  ) )   CALL iom_put( "hfxsensib"  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux
336      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( "hfxcndbot"  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux
337      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( "hfxcndtop"  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux
338
339      ! diags
340      IF( iom_use('hfxdhc'     ) )   CALL iom_put ("hfxdhc"     , diag_heat           )   ! Heat content variation in snow and ice
341      !
342      ! controls
343      !---------
344#if ! defined key_agrif
345      IF( ln_icediachk .AND. .NOT. ln_bdy)   CALL ice_cons_final('iceupdate')                                       ! conservation
346#endif
347      IF( ln_icectl                      )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints
348      IF( ln_ctl                         )   CALL ice_prt3D     ('iceupdate')                                       ! prints
349      IF( ln_timing                      )   CALL timing_stop   ('ice_update')                                      ! timing
350      !
351   END SUBROUTINE ice_update_flx
352
353
354   SUBROUTINE ice_update_tau( kt, pu_oce, pv_oce )
355      !!-------------------------------------------------------------------
356      !!                ***  ROUTINE ice_update_tau ***
357      !! 
358      !! ** Purpose : Update the ocean surface stresses due to the ice
359      !!         
360      !! ** Action  : * at each ice time step (every nn_fsbc time step):
361      !!                - compute the modulus of ice-ocean relative velocity
362      !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid)
363      !!                      tmod_io = rhoco * | U_ice-U_oce |
364      !!                - update the modulus of stress at ocean surface
365      !!                      taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce |
366      !!              * at each ocean time step (every kt):
367      !!                  compute linearized ice-ocean stresses as
368      !!                      Utau = tmod_io * | U_ice - pU_oce |
369      !!                using instantaneous current ocean velocity (usually before)
370      !!
371      !!    NB: - ice-ocean rotation angle no more allowed
372      !!        - here we make an approximation: taum is only computed every ice time step
373      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids
374      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
375      !!
376      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
377      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
378      !!---------------------------------------------------------------------
379      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
380      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
381      !
382      INTEGER  ::   ji, jj   ! dummy loop indices
383      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar
384      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      -
385      !!---------------------------------------------------------------------
386      IF( ln_timing )   CALL timing_start('ice_update_tau')
387
388      IF( kt == nit000 .AND. lwp ) THEN
389         WRITE(numout,*)
390         WRITE(numout,*)'ice_update_tau: update stress at the ice-ocean interface'
391         WRITE(numout,*)'~~~~~~~~~~~~~~'
392      ENDIF
393
394      zrhoco = rau0 * rn_cio
395      !
396      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
397         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
398            DO ji = fs_2, fs_jpim1
399               !                                               ! 2*(U_ice-U_oce) at T-point
400               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
401               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
402               !                                              ! |U_ice-U_oce|^2
403               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
404               !                                               ! update the ocean stress modulus
405               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt
406               tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
407            END DO
408         END DO
409         CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. )
410         !
411         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step
412         vtau_oce(:,:) = vtau(:,:)
413         !
414      ENDIF
415      !
416      !                                      !==  every ocean time-step  ==!
417      !
418      DO jj = 2, jpjm1                                !* update the stress WITHOUT an ice-ocean rotation angle
419         DO ji = fs_2, fs_jpim1   ! Vect. Opt.   
420            ! ice area at u and v-points
421            zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  &
422               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) )
423            zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  &
424               &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) )
425            !                                                   ! linearized quadratic drag formulation
426            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
427            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
428            !                                                   ! stresses at the ocean surface
429            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
430            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
431         END DO
432      END DO
433      CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition
434      !
435      IF( ln_timing )   CALL timing_stop('ice_update_tau')
436      ! 
437   END SUBROUTINE ice_update_tau
438
439
440   SUBROUTINE ice_update_init
441      !!-------------------------------------------------------------------
442      !!                  ***  ROUTINE ice_update_init  ***
443      !!             
444      !! ** Purpose :   allocate ice-ocean stress fields and read restarts
445      !!                containing the snow & ice mass
446      !!
447      !!-------------------------------------------------------------------
448      INTEGER  ::   ji, jj, jk               ! dummy loop indices
449      REAL(wp) ::   zcoefu, zcoefv, zcoeff   ! local scalar
450      !!-------------------------------------------------------------------
451      !
452      IF(lwp) WRITE(numout,*)
453      IF(lwp) WRITE(numout,*) 'ice_update_init: ice-ocean stress init'
454      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
455      !
456      !                                      ! allocate ice_update array
457      IF( ice_update_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_update_init : unable to allocate standard arrays' )
458      !
459      CALL update_rst( 'READ' )  !* read or initialize all required files
460      !
461   END SUBROUTINE ice_update_init
462
463
464   SUBROUTINE update_rst( cdrw, kt )
465      !!---------------------------------------------------------------------
466      !!                   ***  ROUTINE rhg_evp_rst  ***
467      !!                     
468      !! ** Purpose :   Read or write RHG file in restart file
469      !!
470      !! ** Method  :   use of IOM library
471      !!----------------------------------------------------------------------
472      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
473      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
474      !
475      INTEGER  ::   iter   ! local integer
476      INTEGER  ::   id1    ! local integer
477      !!----------------------------------------------------------------------
478      !
479      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialize
480         !                                   ! ---------------
481         IF( ln_rstart ) THEN                   !* Read the restart file
482            !
483            id1 = iom_varid( numrir, 'snwice_mass' , ldstop = .FALSE. )
484            !
485            IF( id1 > 0 ) THEN                       ! fields exist
486               CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass   )
487               CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
488            ELSE                                     ! start from rest
489               IF(lwp) WRITE(numout,*) '   ==>>   previous run without snow-ice mass output then set it'
490               snwice_mass  (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) )
491               snwice_mass_b(:,:) = snwice_mass(:,:)
492            ENDIF
493         ELSE                                   !* Start from rest
494            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set the snow-ice mass'
495            snwice_mass  (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) )
496            snwice_mass_b(:,:) = snwice_mass(:,:)
497         ENDIF
498         !
499      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
500         !                                   ! -------------------
501         IF(lwp) WRITE(numout,*) '---- update-rst ----'
502         iter = kt + nn_fsbc - 1             ! ice restarts are written at kt == nitrst - nn_fsbc + 1
503         !
504         CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass   )
505         CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
506         !
507      ENDIF
508      !
509   END SUBROUTINE update_rst
510
511#else
512   !!----------------------------------------------------------------------
513   !!   Default option         Dummy module           NO SI3 sea-ice model
514   !!----------------------------------------------------------------------
515#endif 
516
517   !!======================================================================
518END MODULE iceupdate
Note: See TracBrowser for help on using the repository browser.