/[lmdze]/trunk/phylmd/Interface_surf/calcul_fluxs.f
ViewVC logotype

Diff of /trunk/phylmd/Interface_surf/calcul_fluxs.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/phylmd/Interface_surf/calcul_fluxs.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/phylmd/Interface_surf/calcul_fluxs.f revision 104 by guez, Thu Sep 4 10:05:52 2014 UTC
# Line 4  module calcul_fluxs_m Line 4  module calcul_fluxs_m
4    
5  contains  contains
6    
7    SUBROUTINE calcul_fluxs( klon, knon, nisurf, dtime,  &    SUBROUTINE calcul_fluxs(nisurf, dtime, tsurf, p1lay, cal, beta, coef1lay, &
8         tsurf, p1lay, cal, beta, coef1lay, ps,  &         ps, qsurf, radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, petAcoef, &
9         precip_rain, precip_snow, snow, qsurf,  &         peqAcoef, petBcoef, peqBcoef, tsurf_new, evap, fluxlat, fluxsens, &
10         radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay,  &         dflux_s, dflux_l)
11         petAcoef, peqAcoef, petBcoef, peqBcoef,  &  
12         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)      ! Cette routine calcule les fluxs en h et q à l'interface et une
13        ! température de surface.
14      ! Cette routine calcule les fluxs en h et q a l'interface et eventuellement  
15      ! une temperature de surface (au cas ou ok_veget = false)      ! L. Fairhead April 2000
16    
17      ! L. Fairhead 4/2000      USE abort_gcm_m, ONLY: abort_gcm
18        USE indicesol, ONLY: is_ter
19      ! input:      USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep
20      ! knon nombre de points a traiter      USE interface_surf, ONLY: run_off
21      ! nisurf surface a traiter      use nr_util, only: assert_eq
22      ! tsurf temperature de surface      USE suphec_m, ONLY: rcpd, rd, retv, rkappa, rlstt, rlvtt, rtt
23      ! p1lay pression 1er niveau (milieu de couche)      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
24      ! cal capacite calorifique du sol  
25      ! beta evap reelle      integer, intent(IN):: nisurf ! surface a traiter
26      ! coef1lay coefficient d'echange      real, intent(IN):: dtime
27      ! ps pression au sol      real, intent(IN):: tsurf(:) ! (knon) temperature de surface
28      ! precip_rain precipitations liquides      real, intent(IN):: p1lay(:) ! (knon) pression 1er niveau (milieu de couche)
29      ! precip_snow precipitations solides      real, intent(IN):: cal(:) ! (knon) capacité calorifique du sol
30      ! snow champs hauteur de neige      real, intent(IN):: beta(:) ! (knon) evap reelle
31      ! runoff runoff en cas de trop plein      real, intent(IN):: coef1lay(:) ! (knon) coefficient d'échange
32      ! petAcoef coeff. A de la resolution de la CL pour t      real, intent(IN):: ps(:) ! (knon) pression au sol
33      ! peqAcoef coeff. A de la resolution de la CL pour q      real, intent(OUT):: qsurf(:) ! (knon) humidite de l'air au dessus du sol
34        real, intent(IN):: radsol(:) ! (knon) rayonnement net au sol (LW + SW)
35    
36        real, intent(IN):: dif_grnd(:) ! (knon)
37        ! coefficient diffusion vers le sol profond
38    
39        real, intent(IN):: t1lay(:), q1lay(:), u1lay(:), v1lay(:) ! (knon)
40    
41        real, intent(IN):: petAcoef(:), peqAcoef(:) ! (knon)
42        ! coefficients A de la résolution de la couche limite pour t et q
43    
44        real, intent(IN):: petBcoef(:), peqBcoef(:) ! (knon)
45      ! petBcoef coeff. B de la resolution de la CL pour t      ! petBcoef coeff. B de la resolution de la CL pour t
46      ! peqBcoef coeff. B de la resolution de la CL pour q      ! peqBcoef coeff. B de la resolution de la CL pour q
     ! radsol rayonnement net aus sol (LW + SW)  
     ! dif_grnd coeff. diffusion vers le sol profond  
47    
48      ! output:      real, intent(OUT):: tsurf_new(:) ! (knon) température au sol
49      ! tsurf_new temperature au sol      real, intent(OUT):: evap(:), fluxlat(:), fluxsens(:) ! (knon)
     ! qsurf humidite de l'air au dessus du sol  
     ! fluxsens flux de chaleur sensible  
50      ! fluxlat flux de chaleur latente      ! fluxlat flux de chaleur latente
51        ! fluxsens flux de chaleur sensible
52        real, intent(OUT):: dflux_s(:), dflux_l(:) ! (knon)
53        ! Dérivées des flux dF/dTs (W m-2 K-1)
54      ! dflux_s derivee du flux de chaleur sensible / Ts      ! dflux_s derivee du flux de chaleur sensible / Ts
55      ! dflux_l derivee du flux de chaleur latente / Ts      ! dflux_l derivee du flux de chaleur latente / Ts
56    
57        ! Local:
58      use indicesol      integer i
59      use abort_gcm_m, only: abort_gcm      real, dimension(size(ps)) :: zx_mh, zx_nh, zx_oh
60      use yoethf_m      real, dimension(size(ps)) :: zx_mq, zx_nq, zx_oq
61      use fcttre, only: thermcep, foeew, qsats, qsatl, foede, dqsats, dqsatl      real, dimension(size(ps)) :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef
62      use SUPHEC_M      real, dimension(size(ps)) :: zx_sl, zx_k1
63      use interface_surf      real, dimension(size(ps)) :: zx_q_0 , d_ts
64        logical zdelta
65      ! Parametres d'entree      real zcvm5, zx_qs, zcor, zx_dq_s_dh
     integer, intent(IN) :: knon, nisurf, klon  
     real , intent(IN) :: dtime  
     real, dimension(klon), intent(IN) :: petAcoef, peqAcoef  
     real, dimension(klon), intent(IN) :: petBcoef, peqBcoef  
     real, dimension(klon), intent(IN) :: ps, q1lay  
     real, dimension(klon), intent(IN) :: tsurf, p1lay, cal, beta, coef1lay  
     real, dimension(klon), intent(IN) :: precip_rain, precip_snow  
     real, dimension(klon), intent(IN) :: radsol, dif_grnd  
     real, dimension(klon), intent(IN) :: t1lay, u1lay, v1lay  
     real, dimension(klon), intent(INOUT) :: snow, qsurf  
   
     ! Parametres sorties  
     real, dimension(klon), intent(OUT):: tsurf_new, evap, fluxsens, fluxlat  
     real, dimension(klon), intent(OUT):: dflux_s, dflux_l  
   
     ! Variables locales  
     integer :: i  
     real, dimension(klon) :: zx_mh, zx_nh, zx_oh  
     real, dimension(klon) :: zx_mq, zx_nq, zx_oq  
     real, dimension(klon) :: zx_pkh, zx_dq_s_dt, zx_qsat, zx_coef  
     real, dimension(klon) :: zx_sl, zx_k1  
     real, dimension(klon) :: zx_q_0 , d_ts  
     real :: zdelta, zcvm5, zx_qs, zcor, zx_dq_s_dh  
66      real :: bilan_f, fq_fonte      real :: bilan_f, fq_fonte
67      REAL :: subli, fsno      REAL :: subli, fsno
68      REAL :: qsat_new, q1_new      REAL :: qsat_new, q1_new
69      real, parameter :: t_grnd = 271.35, t_coup = 273.15      integer knon ! nombre de points a traiter
70      !! PB temporaire en attendant mieux pour le modele de neige      real, parameter:: t_grnd = 271.35, t_coup = 273.15
     REAL, parameter :: chasno = 3.334E+05/(2.3867E+06*0.15)  
   
     logical, save :: check = .false.  
     character (len = 20) :: modname = 'calcul_fluxs'  
     logical, save :: fonte_neige = .false.  
     real, save :: max_eau_sol = 150.0  
     character (len = 80) :: abort_message  
     logical, save :: first = .true., second=.false.  
   
     if (check) write(*, *)'Entree ', modname, ' surface = ', nisurf  
   
     IF (check) THEN  
        WRITE(*, *)' radsol (min, max)' &  
             , MINVAL(radsol(1:knon)), MAXVAL(radsol(1:knon))  
        !!CALL flush(6)  
     ENDIF  
   
     if (size(coastalflow) /= knon .AND. nisurf == is_ter) then  
        write(*, *)'Bizarre, le nombre de points continentaux'  
        write(*, *)'a change entre deux appels. J''arrete ...'  
        abort_message='Pb run_off'  
        call abort_gcm(modname, abort_message, 1)  
     endif  
71    
72      ! Traitement neige et humidite du sol      !---------------------------------------------------------------------
73    
74        knon = assert_eq((/size(tsurf), size(p1lay), size(cal), size(beta), &
75             size(coef1lay), size(ps), size(qsurf), size(radsol), size(dif_grnd), &
76             size(t1lay), size(q1lay), size(u1lay), size(v1lay), size(petAcoef), &
77             size(peqAcoef), size(petBcoef), size(peqBcoef), size(tsurf_new), &
78             size(evap), size(fluxlat), size(fluxsens), size(dflux_s), &
79             size(dflux_l)/), "calcul_fluxs knon")
80    
81        if (size(run_off) /= knon .AND. nisurf == is_ter) then
82           print *, 'Bizarre, le nombre de points continentaux'
83           print *, 'a change entre deux appels. J''arrete.'
84           call abort_gcm('calcul_fluxs', 'Pb run_off', 1)
85        endif
86    
87      ! Initialisation      ! Traitement humidite du sol
88    
89      evap = 0.      evap = 0.
90      fluxsens=0.      fluxsens=0.
# Line 120  contains Line 97  contains
97      DO i = 1, knon      DO i = 1, knon
98         zx_pkh(i) = (ps(i)/ps(i))**RKAPPA         zx_pkh(i) = (ps(i)/ps(i))**RKAPPA
99         IF (thermcep) THEN         IF (thermcep) THEN
100            zdelta=MAX(0., SIGN(1., rtt-tsurf(i)))            zdelta= rtt >= tsurf(i)
101            zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta            zcvm5 = merge(R5IES*RLSTT, R5LES*RLVTT, zdelta)
102            zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q1lay(i))            zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q1lay(i))
103            zx_qs= r2es * FOEEW(tsurf(i), zdelta)/ps(i)            zx_qs= r2es * FOEEW(tsurf(i), zdelta)/ps(i)
104            zx_qs=MIN(0.5, zx_qs)            zx_qs=MIN(0.5, zx_qs)
Legend:
Removed from v.76  
changed lines
  Added in v.104
  ViewVC Help
Powered by ViewVC 1.1.21