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

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

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