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 – NEMO

source: trunk/NEMO/LIM_SRC/limflx.F90 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.4 KB
Line 
1MODULE limflx
2   !!======================================================================
3   !!                       ***  MODULE limflx   ***
4   !!           computation of the flux at the sea ice/ocean interface
5   !!======================================================================
6#if defined key_ice_lim
7   !!----------------------------------------------------------------------
8   !!   'key_ice_lim'                                     LIM sea-ice model
9   !!----------------------------------------------------------------------
10   !!   lim_flx  : flux at the ice / ocean interface
11   !! * Modules used
12   USE phycst
13   USE ocfzpt
14   USE ice_oce
15   USE flx_oce
16   USE ice
17   USE flxblk
18   USE lbclnk
19   USE in_out_manager
20
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Routine accessibility
25   PUBLIC lim_flx       ! called by lim_step
26
27  !! * Module variables
28     REAL(wp)  ::            &  ! constant values
29         epsi16 = 1e-16   ,  &
30         rzero  = 0.0    ,  &
31         rone   = 1.0
32   !! * Substitutions
33#  include "vectopt_loop_substitute.h90"
34   !!----------------------------------------------------------------------
35   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE lim_flx
40      !!-------------------------------------------------------------------
41      !!                ***  ROUTINE lim_flx ***
42      !!               
43      !! 
44      !! ** Purpose : Computes the mass and heat fluxes to the ocean
45      !!         
46      !! ** Action  : - Initialisation of some variables
47      !!              - comput. of the fluxes at the sea ice/ocean interface
48      !!     
49      !! ** Outputs : - fsolar  : solar heat flux at sea ice/ocean interface
50      !!              - fnsolar : non solar heat flux
51      !!              - fsalt   : salt flux at sea ice/ocean interface
52      !!              - fmass   : freshwater flux at sea ice/ocean interface
53      !!
54      !!
55      !! ** References :
56      !!       H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
57      !!         original    : 00-01 (LIM)
58      !!         addition    : 02-07 (C. Ethe, G. Madec)
59      !!---------------------------------------------------------------------
60      !! * Modules used
61      !! * Local variables
62      INTEGER ::   ji, jj         ! dummy loop indices
63
64      INTEGER ::   &
65         ifvt, i1mfr, idfr ,   &  ! some switches
66         iflt, ial, iadv, ifral, ifrdv
67     
68      REAL(wp) ::   &
69         zinda  ,              &  ! switch for testing the values of ice concentration
70         z1mthcm,              &  ! 1 - thcm
71!!         zfcm1  ,              &  ! solar  heat fluxes
72!!         zfcm2  ,              &  !  non solar heat fluxes
73#if defined key_lim_fdd   
74         zfons,                &  ! salt exchanges at the ice/ocean interface
75         zpme                     ! freshwater exchanges at the ice/ocean interface
76#else
77         zprs  , zfons,        &  ! salt exchanges at the ice/ocean interface
78         zpmess                   ! freshwater exchanges at the ice/ocean interface
79#endif
80      REAL(wp), DIMENSION(jpi,jpj) ::  &
81         zfcm1  ,              &  ! solar  heat fluxes
82         zfcm2                    !  non solar heat fluxes     
83#if defined key_coupled   
84      REAL(wp), DIMENSION(jpi,jpj) ::  &
85         zalb  ,               &  ! albedo of ice under overcast sky
86         zalcn ,               &  ! albedo of ocean under overcast sky
87         zalbp ,               &  ! albedo of ice under clear sky
88         zaldum                   ! albedo of ocean under clear sky
89#endif
90      !!---------------------------------------------------------------------
91     
92      !---------------------------------!
93      !      Sea ice/ocean interface    !
94      !---------------------------------!
95       
96       
97      !      heat flux at the ocean surface
98      !-------------------------------------------------------
99       
100      DO jj = 1, jpj
101         DO ji = 1, jpi
102            zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )
103            ifvt    = zinda  *  MAX( rzero , SIGN( rone, -phicif(ji,jj) ) )
104            i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( 1.0 - frld(ji,jj) ) ) )
105            idfr    = 1.0 - MAX( rzero , SIGN( rone , frld(ji,jj) - pfrld(ji,jj) ) )
106            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )
107            ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr
108            iadv    = ( 1  - i1mfr ) * zinda
109            ifral   = ( 1  - i1mfr * ( 1 - ial ) )   
110            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
111            z1mthcm =   1. - thcm(ji,jj)       
112            !   computation the solar flux at ocean surface
113            zfcm1(ji,jj)   = pfrld(ji,jj) * qsr_oce(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
114            !  computation the non solar heat flux at ocean surface
115            zfcm2(ji,jj) =  - z1mthcm * zfcm1(ji,jj)   &
116               &           + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            &
117               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice   &
118               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice
119
120            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ???
121           
122            fsolar (ji,jj) = zfcm1(ji,jj)                                       ! solar heat flux
123
124            fnsolar(ji,jj) = zfcm2(ji,jj) - fdtcn(ji,jj)                        ! non solar heat flux
125         END DO
126      END DO
127 
128       
129      !      mass flux at the ocean surface
130      !-------------------------------------------------------
131       
132      DO jj = 1, jpj
133         DO ji = 1, jpi
134#if defined key_lim_fdd
135            !  case of realistic freshwater flux (Tartinville et al., 2001)
136           
137            !  computing freshwater exchanges at the ice/ocean interface
138            zpme = - evap(ji,jj) * frld(ji,jj)            &   !  evaporation over oceanic fraction
139               &   + tprecip(ji,jj)                            &   !  total precipitation
140               &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )  &   !  remov. snow precip over ice
141               &   - rdmsnif(ji,jj) / rdt_ice                   !  freshwaterflux due to snow melting
142           
143            !  computing salt exchanges at the ice/ocean interface
144            zfons =  ( soce - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
145           
146            !  converting the salt flux from ice to a freshwater flux from ocean
147            fsalt(ji,jj) = zfons / ( sss_io(ji,jj) + epsi16 )
148           
149            !  freshwater masses
150            fmass(ji,jj) = - zpme 
151#else
152            !  case of freshwater flux equivalent as salt flux
153            !  dilution effect due to evaporation and precipitation
154            zprs  = ( tprecip(ji,jj) - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ) * soce 
155            !  freshwater flux
156            zfons = rdmicif(ji,jj) * ( soce - sice )  &  !  fwf : ice formation and melting
157               &   -  dmgwi(ji,jj) * sice             &  !  fwf : salt flx needed to bring the fresh snow to sea/ice salinity
158               &   + rdmsnif(ji,jj) * soce               !  fwf to ocean due to snow melting
159            !  salt exchanges at the ice/ocean interface
160            zpmess         =  zprs - zfons / rdt_ice - evap(ji,jj) * soce * frld(ji,jj)
161            fsalt(ji,jj) =  - zpmess
162#endif
163         END DO
164      END DO
165
166
167      !-------------------------------------------------------------------!
168      !  computation of others transmitting variables from ice to ocean   !
169      !------------------------------------------ ------------------------!
170
171      !-----------------------------------------------!
172      !   Storing the transmitted variables           !
173      !-----------------------------------------------!
174
175      DO jj = 1, jpj
176         DO ji = 1, jpi
177            ftaux (ji,jj) = - tio_u(ji,jj) * rau0   ! taux ( ice: N/m2/rau0, ocean: N/m2 )
178            ftauy (ji,jj) = - tio_v(ji,jj) * rau0   ! tauy ( ice: N/m2/rau0, ocean: N/m2 )               
179            freeze(ji,jj) = 1.0 - frld(ji,jj)       ! Sea ice cover           
180            tn_ice(ji,jj) = sist(ji,jj)             ! Ice surface temperature                     
181         END DO
182      END DO
183
184#if defined key_coupled           
185      zalb  (:,:) = 0.e0
186      zalcn (:,:) = 0.e0
187      zalbp (:,:) = 0.e0
188      zaldum(:,:) = 0.e0
189
190      !------------------------------------------------!
191      !  2) Computation of snow/ice and ocean albedo   !
192      !------------------------------------------------!
193      CALL flx_blk_albedo( zalb, zalcn, zalbp, zaldum )
194
195      DO jj = 1, jpj
196         DO ji = 1, jpi
197            alb_ice(ji,jj) =  0.5 * zalbp(ji,jj) + 0.5 * zalb (ji,jj)  ! Ice albedo                       
198         END DO
199      END DO
200#endif
201
202      IF( l_ctl .AND. lwp ) THEN
203         WRITE(numout,*) ' lim_flx  '
204         WRITE(numout,*) ' fsolar ', SUM(fsolar), ' fnsolar', SUM( fnsolar )
205         WRITE(numout,*) ' fmass  ', SUM(fmass ), ' fsalt  ', SUM(fsalt)
206         WRITE(numout,*) ' ftaux  ', SUM(ftaux ), ' ftauy  ', SUM(ftauy)
207         WRITE(numout,*) ' freeze ', SUM(freeze), ' tn_ice ', SUM(tn_ice)
208      ENDIF
209 
210   
211    END SUBROUTINE lim_flx
212
213#else
214   !!----------------------------------------------------------------------
215   !!   Default option :        Empty module           NO LIM sea-ice model
216   !!----------------------------------------------------------------------
217CONTAINS
218   SUBROUTINE lim_flx         ! Empty routine
219   END SUBROUTINE lim_flx
220#endif
221
222END MODULE limflx
Note: See TracBrowser for help on using the repository browser.