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.
limflx.F90 in trunk/NEMO/LIM_SRC_3 – NEMO

source: trunk/NEMO/LIM_SRC_3/limflx.F90 @ 834

Last change on this file since 834 was 834, checked in by ctlod, 16 years ago

Clean comments and useless lines, see ticket:#72

File size: 16.9 KB
Line 
1MODULE limflx
2   !!======================================================================
3   !!                       ***  MODULE limflx   ***
4   !!           computation of the flux at the sea ice/ocean interface
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3'                                      LIM3 sea-ice model
9   !!----------------------------------------------------------------------
10   !!   lim_flx  : flux at the ice / ocean interface
11   !! * Modules used
12   USE par_oce
13   USE phycst
14   USE ocfzpt
15   USE ice_oce
16   USE flx_oce
17   USE dom_oce
18   USE ice
19   USE flxblk
20   USE lbclnk
21   USE in_out_manager
22   USE albedo
23   USE par_ice
24   USE prtctl           ! Print control
25
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Routine accessibility
30   PUBLIC lim_flx       ! called by lim_step
31
32  !! * Module variables
33     REAL(wp)  ::            &  ! constant values
34         epsi16 = 1e-16   ,  &
35         rzero  = 0.0    ,  &
36         rone   = 1.0
37   !! * Substitutions
38#  include "vectopt_loop_substitute.h90"
39   !!----------------------------------------------------------------------
40   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
41   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limflx.F90,v 1.6 2005/03/27 18:34:41 opalod Exp $
42   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE lim_flx
47      !!-------------------------------------------------------------------
48      !!                ***  ROUTINE lim_flx ***
49      !!               
50      !! 
51      !! ** Purpose : Computes the mass and heat fluxes to the ocean
52      !!         
53      !! ** Action  : - Initialisation of some variables
54      !!              - comput. of the fluxes at the sea ice/ocean interface
55      !!     
56      !! ** Outputs : - fsolar  : solar heat flux at sea ice/ocean interface
57      !!              - fnsolar : non solar heat flux
58      !!              - fsalt   : salt flux at sea ice/ocean interface
59      !!              - fmass   : freshwater flux at sea ice/ocean interface
60      !!
61      !!
62      !! ** References :
63      !!       H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
64      !!         original    : 00-01 (LIM)
65      !!         addition    : 02-07 (C. Ethe, G. Madec)
66      !!---------------------------------------------------------------------
67
68      !! * Modules used
69      !! * Local variables
70      INTEGER ::   ji, jj             ! dummy loop indices
71
72      INTEGER ::   &
73         ifvt, i1mfr, idfr ,   &  ! some switches
74         iflt, ial, iadv, ifral, ifrdv
75     
76      REAL(wp) ::   &
77         zinda  ,              &  ! switch for testing the values of ice concentration
78!!         zfcm1  ,              &  ! solar  heat fluxes
79!!         zfcm2  ,              &  !  non solar heat fluxes
80           zfold  ,            &
81#if defined key_lim_fdd   
82         zfons,                &  ! salt exchanges at the ice/ocean interface
83         zpme                     ! freshwater exchanges at the ice/ocean interface
84#else
85         zprs  , zfons,        &  ! salt exchanges at the ice/ocean interface
86         zpmess                   ! freshwater exchanges at the ice/ocean interface
87#endif
88      REAL(wp), DIMENSION(jpi,jpj) ::  &
89         zfcm1  ,              &  ! solar  heat fluxes
90         zfcm2                    !  non solar heat fluxes     
91#if defined key_coupled   
92      REAL(wp), DIMENSION(jpi,jpj) ::  &
93         zalb  ,               &  ! albedo of ice under overcast sky
94         zalcn ,               &  ! albedo of ocean under overcast sky
95         zalbp ,               &  ! albedo of ice under clear sky
96         zaldum                   ! albedo of ocean under clear sky
97#endif
98      !!---------------------------------------------------------------------
99     
100      !---------------------------------!
101      !      Sea ice/ocean interface    !
102      !---------------------------------!
103       
104      !      heat flux at the ocean surface
105      !-------------------------------------------------------
106      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
107      ! changed to old_frld and old ht_i
108       
109      DO jj = 1, jpj
110         DO ji = 1, jpi
111            zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )
112            ifvt    = zinda  *  MAX( rzero , SIGN( rone, -phicif  (ji,jj) ) )  !subscripts are bad here
113            i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( at_i(ji,jj)       ) ) )
114            idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) )
115            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )
116            ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr
117            iadv    = ( 1  - i1mfr ) * zinda
118            ifral   = ( 1  - i1mfr * ( 1 - ial ) )   
119            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
120
121       ! switch --- 1.0 ---------------- 0.0 --------------------
122       ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
123       ! zinda   | if pfrld = 1       | if pfrld < 1            |
124       !  -> ifvt| if pfrld old_ht_i
125       ! i1mfr   | if frld = 1        | if frld  < 1            |
126       ! idfr    | if frld <= pfrld    | if frld > pfrld        |
127       ! iflt    |
128       ! ial     |
129       ! iadv    |
130       ! ifral
131       ! ifrdv
132
133            !   computation the solar flux at ocean surface
134            zfcm1(ji,jj)   = pfrld(ji,jj) * qsr_oce(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
135                ! fstric     Solar flux transmitted trough the ice
136                ! qsr_oce    Net short wave heat flux on free ocean
137! new line
138            fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj)
139
140            !  computation the non solar heat flux at ocean surface
141            zfcm2(ji,jj) = - zfcm1(ji,jj)                  &
142               &           + iflt    * ( fscmbq(ji,jj) )   & ! total abl -> fscmbq is given to the ocean
143! fscmbq and ffltbif are obsolete
144!              &           + iflt * ffltbif(ji,jj) !!! only if one category is used
145               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice   &
146               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice                     &
147               &           + fhmec(ji,jj)     & ! new contribution due to snow melt in ridging!!
148               &           + fheat_rpo(ji,jj) & ! contribution from ridge formation
149               &           + fheat_res(ji,jj)
150                ! fscmbq  Part of the solar radiation transmitted through the ice and going to the ocean
151                !         computed in limthd_zdf.F90
152                ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t
153                ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok)
154                ! qldif   heat balance of the lead (or of the open ocean)
155                ! qfvbq   i think this is wrong!
156                ! ---> Array used to store energy in case of total lateral ablation
157                ! qfvbq latent heat uptake/release after accretion/ablation
158                ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead
159
160            IF ( num_sal .EQ. 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + &
161                                  fhbri(ji,jj) ! new contribution due to brine drainage
162
163            ! bottom radiative component is sent to the computation of the
164            ! oceanic heat flux
165            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     
166
167            ! used to compute the oceanic heat flux at the next time step
168            fsolar (ji,jj) = zfcm1(ji,jj)                                       ! solar heat flux
169            fnsolar(ji,jj) = zfcm2(ji,jj) - fdtcn(ji,jj)                        ! non solar heat flux
170!                           ! fdtcn : turbulent oceanic heat flux
171
172
173            IF ( ( ji .EQ. jiindex ) .AND. ( jj .EQ. jjindex) ) THEN
174               WRITE(numout,*) ' lim_flx : heat fluxes '
175               WRITE(numout,*) ' fsolar    : ', fsolar(jiindex,jjindex)
176               WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindex,jjindex)
177               WRITE(numout,*) ' pfrld     : ', pfrld(jiindex,jjindex)
178               WRITE(numout,*) ' qsr_oce   : ', qsr_oce(jiindex,jjindex)
179               WRITE(numout,*) ' fstric    : ', fstric (jiindex,jjindex)
180               WRITE(numout,*)
181               WRITE(numout,*) ' fnsolar   : ', fnsolar(jiindex,jjindex)
182               WRITE(numout,*) ' zfcm2     : ', zfcm2(jiindex,jjindex)
183               WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindex,jjindex)
184               WRITE(numout,*) ' ifral     : ', ifral
185               WRITE(numout,*) ' ial       : ', ial 
186               WRITE(numout,*) ' qcmif     : ', qcmif(jiindex,jjindex)
187               WRITE(numout,*) ' qldif     : ', qldif(jiindex,jjindex)
188               WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindex,jjindex) / rdt_ice
189               WRITE(numout,*) ' qldif / dt: ', qldif(jiindex,jjindex) / rdt_ice
190               WRITE(numout,*) ' ifrdv     : ', ifrdv
191               WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindex,jjindex)
192               WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindex,jjindex)
193               WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindex,jjindex) / rdt_ice
194               WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindex,jjindex) / rdt_ice
195               WRITE(numout,*) ' '
196               WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindex,jjindex)
197               WRITE(numout,*) ' fhmec     : ', fhmec(jiindex,jjindex)
198               WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindex,jjindex)
199               WRITE(numout,*) ' fhbri     : ', fhbri(jiindex,jjindex)
200               WRITE(numout,*) ' fheat_res : ', fheat_res(jiindex,jjindex)
201            ENDIF
202         END DO
203      END DO
204       
205      !      mass flux at the ocean surface
206      !-------------------------------------------------------
207!     DO jl = 1, jpl
208!        DO jj = 1, jpj
209!           DO ji = 1, jpi
210!              ! this is probably wrong since rdmicif has already been computed
211!              rdmicif(ji,jj) = rdmicif(ji,jj) + rhoic*d_v_i_thd(ji,jj,jl)
212!           END DO
213!        END DO
214!     END DO
215       
216      DO jj = 1, jpj
217         DO ji = 1, jpi
218#if defined key_lim_fdd
219            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED)
220            !  -------------------------------------------------------------------------------------
221            !  The idea of this approach is that the system that we consider is the ICE-OCEAN system
222            !  Thus  FW  flux  =  External ( E-P+snow melt)
223            !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW
224            !                     Associated to Ice formation AND Ice melting
225            !                     Even if i see Ice melting as a FW and SALT flux
226            !       
227
228            !  computing freshwater exchanges at the ice/ocean interface
229            zpme = - evap(ji,jj) * ( 1.0 - at_i(ji,jj) )     &   !  evaporation over oceanic fraction
230               &   + tprecip(ji,jj)                          &   !  total precipitation
231! old fashioned way               
232!              &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )  &   !  remov. snow precip over ice
233               &   - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   !  remov. snow precip over ice
234               &   - rdmsnif(ji,jj) / rdt_ice                &   !  freshwaterflux due to snow melting
235! new contribution from snow falling when ridging
236               &   + fmmec(ji,jj)
237           
238            !  computing salt exchanges at the ice/ocean interface
239            !  sice should be the same as computed with the ice model
240            zfons =  ( soce - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
241! SOCE
242            zfons =  ( sss_io(ji,jj) - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
243           
244            !  salt flux for constant salinity
245            fsalt(ji,jj)      =  zfons / ( sss_io(ji,jj) + epsi16 ) + fsalt_res(ji,jj)
246            zfold             = fsalt(ji,jj)
247           
248            !  salt flux for variable salinity
249            zinda             = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )
250            !correcting brine and salt fluxes
251            fsbri(ji,jj)      =  zinda*fsbri(ji,jj)
252            !  converting the salt fluxes from ice to a freshwater flux from ocean
253            fsalt_res(ji,jj)  =  fsalt_res(ji,jj) / ( sss_io(ji,jj) + epsi16 )
254            fseqv(ji,jj)      =  fseqv(ji,jj)     / ( sss_io(ji,jj) + epsi16 )
255            fsbri(ji,jj)      =  fsbri(ji,jj)     / ( sss_io(ji,jj) + epsi16 )
256            fsalt_rpo(ji,jj)  =  fsalt_rpo(ji,jj) / ( sss_io(ji,jj) + epsi16 )
257
258            !  freshwater mass exchange (positive to the ice, negative for the ocean ?)
259            !  actually it's a salt flux (so it's minus freshwater flux)
260            !  if sea ice grows, zfons is positive, fsalt also
261            !  POSITIVE SALT FLUX FROM THE ICE TO THE OCEAN
262            !  POSITIVE FRESHWATER FLUX FROM THE OCEAN TO THE ICE [kg.m-2.s-1]
263
264            fmass(ji,jj) = - zpme 
265
266#else
267!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
268! ON S'EN TAPE hhhhhhaaaaaaaaaaaaaaaaaahahahahahahahahahahahaha
269!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
270            !  case of freshwater flux equivalent as salt flux
271            !  dilution effect due to evaporation and precipitation
272            zprs  = ( tprecip(ji,jj) - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ) * soce 
273!SOCE
274            zprs  = ( tprecip(ji,jj) - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ) * sss_io(ji,jj)
275            !  freshwater flux
276            zfons = rdmicif(ji,jj) * ( soce - sice )  &  !  fwf : ice formation and melting
277               &   -  dmgwi(ji,jj) * sice             &  !  fwf : salt flx needed to bring the fresh snow to sea/ice salinity
278               &   + rdmsnif(ji,jj) * soce               !  fwf to ocean due to snow melting
279!SOCE
280            zfons = rdmicif(ji,jj) * ( sss_io(ji,jj) - sice )  &  !  fwf : ice formation and melting
281               &   -  dmgwi(ji,jj) * sice             &  !  fwf : salt flx needed to bring the fresh snow to sea/ice salinity
282               &   + rdmsnif(ji,jj) * sss_io(ji,jj)      !  fwf to ocean due to snow melting
283            !  salt exchanges at the ice/ocean interface
284            zpmess         =  zprs - zfons / rdt_ice - evap(ji,jj) * soce * ( 1.0 - at_i(ji,jj) )
285!SOCE
286            zpmess         =  zprs - zfons / rdt_ice - evap(ji,jj) * sss_io(ji,jj) * ( 1.0 - at_i(ji,jj) )
287
288            fsalt(ji,jj) =  - zpmess
289#endif
290!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
291
292         END DO
293      END DO
294
295      fsalt(:,:) = fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:)
296      IF (num_sal.eq.2) THEN
297         !In case of variable salinity the salt flux has to be accounted for differently
298         ! Brine drainage has to be added
299         fsalt(:,:) = fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:)
300      ENDIF
301
302      !-------------------------------------------------------------------!
303      !  computation of others transmitting variables from ice to ocean   !
304      !------------------------------------------ ------------------------!
305
306      !-----------------------------------------------!
307      !   Storing the transmitted variables           !
308      !-----------------------------------------------!
309
310      ftaux (:,:) = - tio_u(:,:) * rau0   ! taux ( ice: N/m2/rau0, ocean: N/m2 )
311      ftauy (:,:) = - tio_v(:,:) * rau0   ! tauy ( ice: N/m2/rau0, ocean: N/m2 )
312      freeze(:,:) = at_i(:,:)             ! Sea ice cover
313      tn_ice(:,:,:) = t_su(:,:,:)
314
315#if defined key_coupled           
316      zalb  (:,:) = 0.e0
317      zalcn (:,:) = 0.e0
318      zalbp (:,:) = 0.e0
319      zaldum(:,:) = 0.e0
320
321      !------------------------------------------------!
322      !  2) Computation of snow/ice and ocean albedo   !
323      !------------------------------------------------!
324      CALL flx_blk_albedo( zalb, zalcn, zalbp, zaldum )
325
326      alb_ice(:,:) =  0.5 * zalbp(:,:) + 0.5 * zalb (:,:)   ! Ice albedo
327#endif
328
329     IF(ln_ctl) THEN
330        CALL prt_ctl(tab2d_1=fsolar, clinfo1=' lim_flx: fsolar : ', tab2d_2=fnsolar, clinfo2=' fnsolar : ')
331        CALL prt_ctl(tab2d_1=fmass , clinfo1=' lim_flx: fmass  : ', tab2d_2=fsalt  , clinfo2=' fsalt   : ')
332        CALL prt_ctl(tab2d_1=ftaux , clinfo1=' lim_flx: ftaux  : ', tab2d_2=ftauy  , clinfo2=' ftauy   : ')
333        CALL prt_ctl(tab2d_1=freeze, clinfo1=' lim_flx: freeze : ')
334        CALL prt_ctl(tab3d_1=tn_ice, clinfo1=' lim_flx: tn_ice : ', kdim=jpl)
335     ENDIF
336
337    END SUBROUTINE lim_flx
338
339#else
340   !!----------------------------------------------------------------------
341   !!   Default option :        Empty module           NO LIM sea-ice model
342   !!----------------------------------------------------------------------
343CONTAINS
344   SUBROUTINE lim_flx         ! Empty routine
345   END SUBROUTINE lim_flx
346#endif
347
348END MODULE limflx
Note: See TracBrowser for help on using the repository browser.