/[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/Sources/phylmd/Interface_surf/calcul_fluxs.f revision 171 by guez, Tue Sep 29 19:48:59 2015 UTC trunk/phylmd/Interface_surf/calcul_fluxs.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# Line 6  contains Line 6  contains
6    
7    SUBROUTINE calcul_fluxs(dtime, tsurf, p1lay, cal, beta, coef1lay, ps, &    SUBROUTINE calcul_fluxs(dtime, tsurf, p1lay, cal, beta, coef1lay, ps, &
8         qsurf, radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, petAcoef, &         qsurf, radsol, dif_grnd, t1lay, q1lay, u1lay, v1lay, petAcoef, &
9         peqAcoef, petBcoef, peqBcoef, tsurf_new, evap, fluxlat, fluxsens, &         peqAcoef, petBcoef, peqBcoef, tsurf_new, evap, fluxlat, flux_t, &
10         dflux_s, dflux_l)         dflux_s, dflux_l)
11    
12      ! Cette routine calcule les fluxs en h et q à l'interface et une      ! Cette routine calcule les flux en h et q à l'interface et une
13      ! température de surface.      ! température de surface.
14    
15      ! L. Fairhead April 2000      ! L. Fairhead, April 2000
16    
17      USE abort_gcm_m, ONLY: abort_gcm      USE fcttre, ONLY: foede, foeew
     USE fcttre, ONLY: dqsatl, dqsats, foede, foeew, qsatl, qsats, thermcep  
     USE indicesol, ONLY: is_ter  
18      use nr_util, only: assert_eq      use nr_util, only: assert_eq
19      USE suphec_m, ONLY: rcpd, rd, retv, rkappa, rlstt, rlvtt, rtt      USE suphec_m, ONLY: rcpd, rd, retv, rlstt, rlvtt, rtt
20      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2      USE yoethf_m, ONLY: r2es, r5ies, r5les, rvtmp2
21    
22      real, intent(IN):: dtime      real, intent(IN):: dtime
23      real, intent(IN):: tsurf(:) ! (knon) temperature de surface      real, intent(IN):: tsurf(:) ! (knon) température de surface
24      real, intent(IN):: p1lay(:) ! (knon) pression 1er niveau (milieu de couche)  
25        real, intent(IN):: p1lay(:) ! (knon)
26        ! pression première couche (milieu de couche)
27    
28      real, intent(IN):: cal(:) ! (knon) capacité calorifique du sol      real, intent(IN):: cal(:) ! (knon) capacité calorifique du sol
29      real, intent(IN):: beta(:) ! (knon) evap reelle      real, intent(IN):: beta(:) ! (knon) évaporation réelle
30      real, intent(IN):: coef1lay(:) ! (knon) coefficient d'échange      real, intent(IN):: coef1lay(:) ! (knon) coefficient d'échange
31      real, intent(IN):: ps(:) ! (knon) pression au sol      real, intent(IN):: ps(:) ! (knon) pression au sol
32      real, intent(OUT):: qsurf(:) ! (knon) humidite de l'air au dessus du sol      real, intent(OUT):: qsurf(:) ! (knon) humidité de l'air au-dessus du sol
33      real, intent(IN):: radsol(:) ! (knon) rayonnement net au sol (LW + SW)  
34        real, intent(IN):: radsol(:) ! (knon)
35        ! rayonnement net au sol (longwave + shortwave)
36    
37      real, intent(IN):: dif_grnd(:) ! (knon)      real, intent(IN):: dif_grnd(:) ! (knon)
38      ! coefficient diffusion vers le sol profond      ! coefficient de diffusion vers le sol profond
39    
40      real, intent(IN):: t1lay(:), q1lay(:), u1lay(:), v1lay(:) ! (knon)      real, intent(IN):: t1lay(:), q1lay(:), u1lay(:), v1lay(:) ! (knon)
41    
42      real, intent(IN):: petAcoef(:), peqAcoef(:) ! (knon)      real, intent(IN):: petAcoef(:), peqAcoef(:) ! (knon)
43      ! coefficients A de la résolution de la couche limite pour t et q      ! coefficients A de la résolution de la couche limite pour T et q
44    
45      real, intent(IN):: petBcoef(:), peqBcoef(:) ! (knon)      real, intent(IN):: petBcoef(:), peqBcoef(:) ! (knon)
46      ! coeff. B de la resolution de la CL pour t et q      ! coefficients B de la résolution de la couche limite pour t et q
47    
48      real, intent(OUT):: tsurf_new(:) ! (knon) température au sol      real, intent(OUT):: tsurf_new(:) ! (knon) température au sol
49      real, intent(OUT):: evap(:) ! (knon)      real, intent(OUT):: evap(:) ! (knon)
50    
51      real, intent(OUT):: fluxlat(:), fluxsens(:) ! (knon)      real, intent(OUT):: fluxlat(:), flux_t(:) ! (knon)
52      ! flux de chaleur latente et sensible      ! flux de chaleurs latente et sensible
53    
54      real, intent(OUT):: dflux_s(:), dflux_l(:) ! (knon)      real, intent(OUT):: dflux_s(:), dflux_l(:) ! (knon)
55      ! dérivées des flux de chaleurs sensible et latente par rapport à      ! dérivées des flux de chaleurs sensible et latente par rapport à
# Line 55  contains Line 58  contains
58      ! Local:      ! Local:
59      integer i      integer i
60      integer knon ! nombre de points a traiter      integer knon ! nombre de points a traiter
61      real, dimension(size(ps)):: mh, oh, mq, nq, oq      real, dimension(size(ps)):: mh, oh, mq, nq, oq, dq_s_dt, coef ! (knon)
62      real, dimension(size(ps)):: dq_s_dt, coef      real qsat(size(ps)) ! (knon) mass fraction
63      real qsat(size(ps)) ! qsat en kg/kg      real sl(size(ps)) ! (knon) chaleur latente d'évaporation ou de sublimation
     real sl(size(ps)) ! chaleur latente d'evaporation ou de sublimation  
64      logical delta      logical delta
65      real zcor      real zcor
66      real, parameter:: t_grnd = 271.35, t_coup = 273.15      real, parameter:: t_grnd = 271.35
67    
68      !---------------------------------------------------------------------      !---------------------------------------------------------------------
69    
# Line 69  contains Line 71  contains
71           size(coef1lay), size(ps), size(qsurf), size(radsol), size(dif_grnd), &           size(coef1lay), size(ps), size(qsurf), size(radsol), size(dif_grnd), &
72           size(t1lay), size(q1lay), size(u1lay), size(v1lay), size(petAcoef), &           size(t1lay), size(q1lay), size(u1lay), size(v1lay), size(petAcoef), &
73           size(peqAcoef), size(petBcoef), size(peqBcoef), size(tsurf_new), &           size(peqAcoef), size(petBcoef), size(peqBcoef), size(tsurf_new), &
74           size(evap), size(fluxlat), size(fluxsens), size(dflux_s), &           size(evap), size(fluxlat), size(flux_t), size(dflux_s), &
75           size(dflux_l)/), "calcul_fluxs knon")           size(dflux_l)/), "calcul_fluxs knon")
76    
77      ! Traitement humidite du sol      ! Traitement de l'humidité du sol
78    
79      IF (thermcep) THEN      DO i = 1, knon
80         DO i = 1, knon         delta = rtt >= tsurf(i)
81            delta = rtt >= tsurf(i)         qsat(i) = MIN(0.5, r2es * FOEEW(tsurf(i), delta) / ps(i))
82            qsat(i) = MIN(0.5, r2es * FOEEW(tsurf(i), delta) / ps(i))         zcor = 1. / (1. - retv * qsat(i))
83            zcor = 1. / (1. - retv * qsat(i))         qsat(i) = qsat(i) * zcor
84            qsat(i) = qsat(i) * zcor         dq_s_dt(i) = RCPD * FOEDE(tsurf(i), delta, merge(R5IES * RLSTT, &
85            dq_s_dt(i) = RCPD * FOEDE(tsurf(i), delta, merge(R5IES * RLSTT, &              R5LES * RLVTT, delta) / RCPD / (1. + RVTMP2 * q1lay(i)), &
86                 R5LES * RLVTT, delta) / RCPD / (1. + RVTMP2 * q1lay(i)), &              qsat(i), zcor) / RLVTT
87                 qsat(i), zcor) / RLVTT      ENDDO
        ENDDO  
     ELSE  
        DO i = 1, knon  
           IF (tsurf(i) < t_coup) THEN  
              qsat(i) = qsats(tsurf(i)) / ps(i)  
              dq_s_dt(i) = RCPD * dqsats(tsurf(i), qsat(i)) / RLVTT  
           ELSE  
              qsat(i) = qsatl(tsurf(i)) / ps(i)  
              dq_s_dt(i) = RCPD * dqsatl(tsurf(i), qsat(i)) / RLVTT  
           ENDIF  
        ENDDO  
     ENDIF  
88    
89      coef = coef1lay * (1. + SQRT(u1lay**2 + v1lay**2)) * p1lay / (RD * t1lay)      coef = coef1lay * (1. + SQRT(u1lay**2 + v1lay**2)) * p1lay / (RD * t1lay)
90      sl = merge(RLSTT, RLVTT, tsurf < RTT)      sl = merge(RLSTT, RLVTT, tsurf < RTT)
# Line 116  contains Line 106  contains
106    
107      evap = - mq - nq * tsurf_new      evap = - mq - nq * tsurf_new
108      fluxlat = - evap * sl      fluxlat = - evap * sl
109      fluxsens = mh + dflux_s * tsurf_new      flux_t = mh + dflux_s * tsurf_new
110      dflux_l = sl * nq      dflux_l = sl * nq
111    
112      ! Nouvelle valeur de l'humidité au dessus du sol :      ! Nouvelle valeur de l'humidité au dessus du sol :
Legend:
Removed from v.171  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21