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.
limsbc_2.F90 in trunk/NEMO/LIM_SRC_2 – NEMO

source: trunk/NEMO/LIM_SRC_2/limsbc_2.F90 @ 1156

Last change on this file since 1156 was 1156, checked in by rblod, 16 years ago

Update Id and licence information, see ticket #210

  • Property svn:keywords set to Id
File size: 11.9 KB
Line 
1MODULE limsbc_2
2   !!======================================================================
3   !!                       ***  MODULE limsbc_2   ***
4   !!           computation of the flux at the sea ice/ocean interface
5   !!======================================================================
6   !! History : 00-01 (H. Goosse) Original code
7   !!           02-07 (C. Ethe, G. Madec) re-writing F90
8   !!           06-07 (G. Madec) surface module
9   !!----------------------------------------------------------------------
10#if defined key_lim2
11   !!----------------------------------------------------------------------
12   !!   'key_lim2'                                    LIM 2.0 sea-ice model
13   !!----------------------------------------------------------------------
14   !!----------------------------------------------------------------------
15   !!   lim_sbc_2  : flux at the ice / ocean interface
16   !!----------------------------------------------------------------------
17   USE par_oce          ! ocean parameters
18   USE dom_oce          ! ocean domain
19   USE sbc_ice          ! surface boundary condition
20   USE sbc_oce          ! surface boundary condition
21   USE phycst           ! physical constants
22   USE ice_oce          ! sea-ice variable
23   USE ice_2            ! LIM sea-ice variables
24   USE iceini_2         ! ???
25   USE dynspg_oce       ! choice of the surface pressure gradient scheme
26
27   USE lbclnk           ! ocean lateral boundary condition
28   USE in_out_manager   ! I/O manager
29   USE albedo           ! albedo parameters
30   USE prtctl           ! Print control
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC lim_sbc_2     ! called by sbc_ice_lim_2
36
37   REAL(wp)  ::   epsi16 = 1.e-16  ! constant values
38   REAL(wp)  ::   rzero  = 0.e0   
39   REAL(wp)  ::   rone   = 1.e0
40
41   !! * Substitutions
42#  include "vectopt_loop_substitute.h90"
43   !!----------------------------------------------------------------------
44   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)
45   !! $Id$
46   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48
49CONTAINS
50
51   SUBROUTINE lim_sbc_2( kt )
52      !!-------------------------------------------------------------------
53      !!                ***  ROUTINE lim_sbc_2 ***
54      !! 
55      !! ** Purpose : Update surface ocean boundary condition over areas
56      !!      that are at least partially covered by sea-ice
57      !!         
58      !! ** Action  : - comput. of the momentum, heat and freshwater/salt
59      !!      fluxes at the ice-ocean interface.
60      !!              - Update
61      !!     
62      !! ** Outputs : - qsr     : sea heat flux:     solar
63      !!              - qns     : sea heat flux: non solar
64      !!              - emp     : freshwater budget: volume flux
65      !!              - emps    : freshwater budget: concentration/dillution
66      !!              - utau    : sea surface i-stress (ocean referential)
67      !!              - vtau    : sea surface j-stress (ocean referential)
68      !!              - fr_i    : ice fraction
69      !!              - tn_ice  : sea-ice surface temperature
70      !!              - alb_ice : sea-ice alberdo (lk_cpl=T)
71      !!
72      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
73      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
74      !!---------------------------------------------------------------------
75      INTEGER ::   kt    ! number of iteration
76      !!
77      INTEGER  ::   ji, jj           ! dummy loop indices
78      INTEGER  ::   ifvt, i1mfr, idfr               ! some switches
79      INTEGER  ::   iflt, ial, iadv, ifral, ifrdv
80      REAL(wp) ::   zqsr  , zqns     ! solar & non solar heat flux
81      REAL(wp) ::   zinda            ! switch for testing the values of ice concentration
82      REAL(wp) ::   zfons            ! salt exchanges at the ice/ocean interface
83      REAL(wp) ::   zemp             ! freshwater exchanges at the ice/ocean interface
84      REAL(wp) ::   zfrldu, zfrldv   ! lead fraction at U- & V-points
85      REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points
86      REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity
87#if defined key_coupled   
88      REAL(wp), DIMENSION(jpi,jpj) ::   zalb     ! albedo of ice under overcast sky
89      REAL(wp), DIMENSION(jpi,jpj) ::   zalbp    ! albedo of ice under clear sky
90#endif
91      REAL(wp) ::   zsang, zmod, zfm
92      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice
93
94      !!---------------------------------------------------------------------
95     
96      IF( kt == nit000 ) THEN
97         IF(lwp) WRITE(numout,*)
98         IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice - surface boundary condition'
99         IF(lwp) WRITE(numout,*) '~~~~~~~~~   '
100      ENDIF
101
102      !------------------------------------------!
103      !      heat flux at the ocean surface      !
104      !------------------------------------------!
105
106!!gm
107!!gm CAUTION   
108!!gm re-verifies the non solar expression, especially over open ocen
109!!gm
110      DO jj = 1, jpj
111         DO ji = 1, jpi
112            zinda   = 1.0   - MAX( rzero , SIGN( rone, - ( 1.0 - pfrld(ji,jj) )   ) )
113            ifvt    = zinda * MAX( rzero , SIGN( rone,  - phicif(ji,jj)           ) )
114            i1mfr   = 1.0   - MAX( rzero , SIGN( rone, - ( 1.0 - frld(ji,jj) )    ) )
115            idfr    = 1.0   - MAX( rzero , SIGN( rone, frld(ji,jj) - pfrld(ji,jj) ) )
116            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )
117            ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr
118            iadv    = ( 1  - i1mfr ) * zinda
119            ifral   = ( 1  - i1mfr * ( 1 - ial ) )   
120            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
121            !   computation the solar flux at ocean surface
122            zqsr    = pfrld(ji,jj) * qsr(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
123            !  computation the non solar heat flux at ocean surface
124            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads
125               &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            &
126               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice   &
127               &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice
128
129            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ???
130           
131            qsr  (ji,jj) = zqsr                                          ! solar heat flux
132            qns  (ji,jj) = zqns - fdtcn(ji,jj)                           ! non solar heat flux
133         END DO
134      END DO
135 
136      !------------------------------------------!
137      !      mass flux at the ocean surface      !
138      !------------------------------------------!
139
140!!gm
141!!gm CAUTION   
142!!gm re-verifies the emp & emps expression, especially the absence of 1-frld on zfm
143!!gm
144      DO jj = 1, jpj
145         DO ji = 1, jpi
146           
147            !  computing freshwater exchanges at the ice/ocean interface
148            zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction
149               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean
150               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  taking into account change in ice cover within the time step
151               &   + rdmsnif(ji,jj) / rdt_ice                      !  freshwaterflux due to snow melting
152               !                                                   !  ice-covered fraction:
153
154            !  computing salt exchanges at the ice/ocean interface
155            zfons =  ( soce - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
156           
157            !  converting the salt flux from ice to a freshwater flux from ocean
158            zfm  = zfons / ( sss_m(ji,jj) + epsi16 )
159           
160            emps(ji,jj) = zemp + zfm      ! surface ocean concentration/dilution effect (use on SSS evolution)
161            emp (ji,jj) = zemp            ! surface ocean volume flux (use on sea-surface height evolution)
162
163         END DO
164      END DO
165
166      IF( lk_dynspg_rl )    emp (:,:) = emps(:,:)      ! rigid-lid formulation : emp = emps
167
168      !------------------------------------------!
169      !    momentum flux at the ocean surface    !
170      !------------------------------------------!
171
172      IF ( ln_limdyn ) THEN                        ! Update the stress over ice-over area (only in ice-dynamic case)
173         !                                         ! otherwise the atmosphere-ocean stress is used everywhere
174
175         ! ... ice stress over ocean with a ice-ocean rotation angle (at I-point)
176!CDIR NOVERRCHK
177         DO jj = 1, jpj
178!CDIR NOVERRCHK
179            DO ji = 1, jpi
180               ! ... change the cosinus angle sign in the south hemisphere
181               zsang  = SIGN(1.e0, gphif(ji,jj) ) * sangvg
182               ! ... ice velocity relative to the ocean
183               zu_io  = ui_ice(ji,jj) - ui_oce(ji,jj)
184               zv_io  = vi_ice(ji,jj) - vi_oce(ji,jj)
185               zmod   = rhoco * SQRT( zu_io * zu_io + zv_io * zv_io )
186               ! ... ice stress over ocean with a ice-ocean rotation angle (at I-point)
187               ztio_u(ji,jj) = zmod * ( cangvg * zu_io - zsang * zv_io )
188               ztio_v(ji,jj) = zmod * ( cangvg * zv_io + zsang * zu_io )
189               !
190            END DO
191         END DO
192
193         DO jj = 2, jpjm1
194            DO ji = fs_2, fs_jpim1   ! vertor opt.
195               ! ... ice-cover wheighted ice-ocean stress at U and V-points  (from I-point values)
196               zutau  = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) )
197               zvtau  = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) )
198               ! ... open-ocean (lead) fraction at U- & V-points (from T-point values)
199               zfrldu = 0.5 * ( frld (ji,jj) + frld (ji+1,jj  ) )
200               zfrldv = 0.5 * ( frld (ji,jj) + frld (ji  ,jj+1) )
201               ! update surface ocean stress
202               utau(ji,jj) = zfrldu * utau(ji,jj) + ( 1. - zfrldu ) * zutau
203               vtau(ji,jj) = zfrldv * vtau(ji,jj) + ( 1. - zfrldv ) * zvtau
204               !
205            END DO
206         END DO
207
208         ! boundary condition on the stress (utau,vtau)
209         CALL lbc_lnk( utau, 'U', -1. )
210         CALL lbc_lnk( vtau, 'V', -1. )
211
212      ENDIF
213
214      !-----------------------------------------------!
215      !   Storing the transmitted variables           !
216      !-----------------------------------------------!
217
218      fr_i  (:,:) = 1.0 - frld(:,:)       ! sea-ice fraction
219      tn_ice(:,:) = sist(:,:)             ! sea-ice surface temperature                     
220
221#if defined key_coupled           
222      !------------------------------------------------!
223      !    Computation of snow/ice and ocean albedo    !
224      !------------------------------------------------!
225      zalb  (:,:) = 0.e0
226      zalbp (:,:) = 0.e0
227
228      CALL albedo_ice( sist, hicif, hsnif, zalbp, zalb )
229
230      alb_ice(:,:) =  0.5 * zalbp(:,:) + 0.5 * zalb (:,:)   ! Ice albedo (mean clear and overcast skys)
231#endif
232
233      IF(ln_ctl) THEN
234         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ')
235         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps  , clinfo2=' emps    : ')
236         CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
237            &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask )
238         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice, clinfo2=' tn_ice  : ')
239      ENDIF
240   
241    END SUBROUTINE lim_sbc_2
242
243#else
244   !!----------------------------------------------------------------------
245   !!   Default option :        Dummy module       NO LIM 2.0 sea-ice model
246   !!----------------------------------------------------------------------
247CONTAINS
248   SUBROUTINE lim_sbc_2         ! Dummy routine
249   END SUBROUTINE lim_sbc_2
250#endif 
251
252   !!======================================================================
253END MODULE limsbc_2
Note: See TracBrowser for help on using the repository browser.