/[lmdze]/trunk/phylmd/Interface_surf/stdlevvar.f90
ViewVC logotype

Diff of /trunk/phylmd/Interface_surf/stdlevvar.f90

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

trunk/Sources/phylmd/stdlevvar.f revision 188 by guez, Tue Mar 22 16:31:39 2016 UTC trunk/phylmd/Interface_surf/stdlevvar.f revision 286 by guez, Tue Jul 24 15:22:48 2018 UTC
# Line 4  module stdlevvar_m Line 4  module stdlevvar_m
4    
5  contains  contains
6    
7    SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, u1, v1, t1, q1, z1, ts1, &    SUBROUTINE stdlevvar(nsrf, u1, v1, t1, q1, z1, ts1, qsurf, rugos, psol, &
8         qsurf, rugos, psol, pat1, t_2m, q_2m, t_10m, q_10m, u_10m, ustar)         pat1, t_2m, q_2m, t_10m, q_10m, wind10m, ustar)
9    
10      ! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3 2005/05/25 13:10:09      ! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3, 2005/05/25 13:10:09
   
     use coefcdrag_m, only: coefcdrag  
     USE suphec_m, ONLY: rg, rkappa  
     use screenp_m, only: screenp  
11    
12      ! Objet : calcul de la température et de l'humidité relative à 2 m      ! Objet : calcul de la température et de l'humidité relative à 2 m
13      ! et du module du vent à 10 m à partir des relations de      ! et du module du vent à 10 m à partir des relations de
# Line 19  contains Line 15  contains
15    
16      ! Reference: Hess, Colman and McAvaney (1995)      ! Reference: Hess, Colman and McAvaney (1995)
17    
18      ! Author: I. Musat, 01.07.2002      ! Author: I. Musat, July 1st, 2002
   
     INTEGER, intent(in):: klon  
     ! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)  
19    
20      INTEGER, intent(in):: knon      use nr_util, only: assert_eq
     ! knon----input-I- nombre de points pour un type de surface  
     INTEGER, intent(in):: nsrf  
     ! nsrf----input-I- indice pour le type de surface; voir indicesol.inc  
     LOGICAL, intent(in):: zxli  
     ! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li  
     REAL, dimension(klon), intent(in):: u1  
     ! u1------input-R- vent zonal au 1er niveau du modele  
     REAL, dimension(klon), intent(in):: v1  
     ! v1------input-R- vent meridien au 1er niveau du modele  
     REAL, dimension(klon), intent(in):: t1  
     ! t1------input-R- temperature de l'air au 1er niveau du modele  
     REAL, dimension(klon), intent(in):: q1  
     ! q1------input-R- humidite relative au 1er niveau du modele  
     REAL, dimension(klon), intent(in):: z1  
     ! z1------input-R- geopotentiel au 1er niveau du modele  
     REAL, dimension(klon), intent(in):: ts1  
     ! ts1-----input-R- temperature de l'air a la surface  
     REAL, dimension(klon), intent(in):: qsurf  
      ! qsurf---input-R- humidite relative a la surface  
     REAL, dimension(klon), intent(in):: rugos  
     ! rugos---input-R- rugosite  
    REAL, dimension(klon), intent(in):: psol  
     ! psol----input-R- pression au sol  
    REAL, dimension(klon), intent(in):: pat1  
     ! pat1----input-R- pression au 1er niveau du modele  
   
     REAL, dimension(klon), intent(out):: t_2m  
     ! t_2m---output-R- temperature de l'air a 2m  
     REAL, dimension(klon), intent(out):: q_2m  
     ! q_2m---output-R- humidite relative a 2m  
     REAL, dimension(klon), intent(out):: t_10m  
     ! t_10m--output-R- temperature de l'air a 10m  
     REAL, dimension(klon), intent(out):: q_10m  
     ! q_10m--output-R- humidite specifique a 10m  
     REAL, dimension(klon), intent(out):: u_10m  
     ! u_10m--output-R- vitesse du vent a 10m  
     REAL, intent(out):: ustar(klon) ! u*  
21    
22      ! Local:      use cdrag_m, only: cdrag
23        USE dimphy, ONLY: klon
24        USE suphec_m, ONLY: rg, rkappa
25        use screenc_m, only: screenc
26        use screenp_m, only: screenp
27    
28      ! RKAR : constante de von Karman      INTEGER, intent(in):: nsrf ! indice pour le type de surface
29      REAL, PARAMETER:: RKAR=0.40      REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
30      ! niter : nombre iterations calcul "corrector"      REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
31      INTEGER, parameter:: niter=2      REAL, intent(in):: t1(:) ! (knon) temperature de l'air au 1er
32                                 ! niveau du modele
33        REAL, intent(in):: q1(klon) ! humidite relative au 1er niveau du modele
34        REAL, intent(in):: z1 (klon) ! geopotentiel au 1er niveau du modele
35        REAL, intent(in):: ts1(klon) ! temperature de l'air a la surface
36        REAL, intent(in):: qsurf(klon) ! humidite relative a la surface
37        REAL, intent(in):: rugos(klon) ! rugosite
38        REAL, intent(in):: psol(klon) ! pression au sol
39        REAL, intent(in):: pat1(klon) ! pression au 1er niveau du modele
40        REAL, intent(out):: t_2m(klon) ! temperature de l'air a 2m
41        REAL, intent(out):: q_2m(klon) ! humidite relative a 2m
42        REAL, intent(out):: t_10m(klon) ! temperature de l'air a 10m
43        REAL, intent(out):: q_10m(klon) ! humidite specifique a 10m
44        REAL, intent(out):: wind10m(:) ! (knon) norme du vent \`a 10m
45        REAL, intent(out):: ustar(:) ! (knon) u*
46    
47      ! Variables locales      ! Local:
48        INTEGER knon ! nombre de points pour un type de surface
49        REAL, PARAMETER:: RKAR = 0.4 ! constante de von Karman
50        INTEGER, parameter:: niter = 2 ! nombre iterations calcul "corrector"
51      INTEGER i, n      INTEGER i, n
52      REAL zref      REAL zref
53      REAL, dimension(klon):: speed      REAL, dimension(klon):: speed
54      ! tpot : temperature potentielle      ! tpot : temperature potentielle
55      REAL, dimension(klon):: tpot      REAL, dimension(klon):: tpot
56      REAL, dimension(klon):: zri1, cdran      REAL cdram(size(u1)), cdrah(size(u1))
     REAL cdram(klon), cdrah(klon)  
     ! ri1 : nb. de Richardson entre la surface --> la 1ere couche  
     REAL, dimension(klon):: ri1  
57      REAL, dimension(klon):: testar, qstar      REAL, dimension(klon):: testar, qstar
58      REAL, dimension(klon):: zdte, zdq      REAL, dimension(klon):: zdte, zdq
59      ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney      ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
60      DOUBLE PRECISION, dimension(klon):: lmon      DOUBLE PRECISION, dimension(klon):: lmon
61      REAL, dimension(klon):: delu, delte, delq      REAL, dimension(klon):: delu, delte, delq
62      REAL, dimension(klon):: u_zref, te_zref, q_zref      REAL, dimension(klon):: u_zref, te_zref, q_zref
63      REAL, dimension(klon):: temp, pref      REAL, dimension(klon):: temp
64      LOGICAL okri      real pref(size(u1)) ! (knon)
     REAL, dimension(klon):: u_zref_p, temp_p, q_zref_p  
     !convertgence  
     REAL, dimension(klon):: u_zref_c, temp_c, q_zref_c  
     REAL, dimension(klon):: ok_pred, ok_corr  
65    
66      !-------------------------------------------------------------------------      !-------------------------------------------------------------------------
67    
68        knon = assert_eq([size(u1), size(v1), size(t1), size(wind10m), &
69             size(ustar)], "stdlevvar knon")
70        
71      DO i=1, knon      DO i=1, knon
72         speed(i)=SQRT(u1(i)**2+v1(i)**2)         speed(i)=SQRT(u1(i)**2+v1(i)**2)
        ri1(i) = 0.0  
73      ENDDO      ENDDO
74    
75      okri=.FALSE.      CALL cdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
76      CALL coefcdrag(klon, knon, nsrf, zxli, speed, t1, q1, z1, psol, ts1, &           psol(:knon), ts1(:knon), qsurf(:knon), rugos(:knon), cdram, cdrah)
          qsurf, rugos, okri, ri1, cdram, cdrah, cdran, zri1, pref)  
77    
78      ! Star variables      ! Star variables
79    
80      DO i = 1, knon      DO i = 1, knon
        ri1(i) = zri1(i)  
81         tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA         tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
82         ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))         ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
83         zdte(i) = tpot(i) - ts1(i)         zdte(i) = tpot(i) - ts1(i)
# Line 117  contains Line 87  contains
87    
88         testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)         testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
89         qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)         qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
90         lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &         lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / (RKAR * RG * testar(i))
             (RKAR * RG * testar(i))  
91      ENDDO      ENDDO
92    
93      ! First aproximation of variables at zref        ! First aproximation of variables at zref  
94      zref = 2.0      zref = 2.0
95      CALL screenp(klon, knon, speed, tpot, q1, &      CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
96           ts1, qsurf, rugos, lmon, &           testar, qstar, zref, delu, delte, delq)
          ustar, testar, qstar, zref, &  
          delu, delte, delq)  
97    
98      DO i = 1, knon      DO i = 1, knon
99         u_zref(i) = delu(i)         u_zref(i) = delu(i)
100         q_zref(i) = max(qsurf(i), 0.0) + delq(i)         q_zref(i) = max(qsurf(i), 0.0) + delq(i)
101         te_zref(i) = ts1(i) + delte(i)         te_zref(i) = ts1(i) + delte(i)
102         temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)         temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
        q_zref_p(i) = q_zref(i)  
        temp_p(i) = temp(i)  
103      ENDDO      ENDDO
104    
105      ! Iteration of the variables at the reference level zref :      ! Iteration of the variables at the reference level zref :
106      ! corrector calculation ; see Hess & McAvaney, 1995      ! corrector calculation ; see Hess & McAvaney, 1995
107    
108      DO n = 1, niter      DO n = 1, niter
109         okri=.TRUE.         CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
110         CALL screenc(klon, knon, nsrf, zxli, &              qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
             u_zref, temp, q_zref, zref, &  
             ts1, qsurf, rugos, psol, &  
             ustar, testar, qstar, okri, ri1, &  
             pref, delu, delte, delq)  
111    
112         DO i = 1, knon         DO i = 1, knon
113            u_zref(i) = delu(i)            u_zref(i) = delu(i)
# Line 154  contains Line 115  contains
115            te_zref(i) = delte(i) + ts1(i)            te_zref(i) = delte(i) + ts1(i)
116    
117            ! return to normal temperature            ! return to normal temperature
   
118            temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)            temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
119         ENDDO         ENDDO
120      ENDDO      ENDDO
# Line 162  contains Line 122  contains
122      ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref      ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
123    
124      DO i = 1, knon      DO i = 1, knon
125         q_zref_c(i) = q_zref(i)         t_2m(i) = temp(i)
126         temp_c(i) = temp(i)         q_2m(i) = q_zref(i)
   
        ok_pred(i)=0.  
        ok_corr(i)=1.  
   
        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)  
        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)  
127      ENDDO      ENDDO
128    
129      ! First aproximation of variables at zref        ! First aproximation of variables at zref  
130    
131      zref = 10.0      zref = 10.
132      CALL screenp(klon, knon, speed, tpot, q1, &      CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
133           ts1, qsurf, rugos, lmon, &           testar, qstar, zref, delu, delte, delq)
          ustar, testar, qstar, zref, &  
          delu, delte, delq)  
134    
135      DO i = 1, knon      DO i = 1, knon
136         u_zref(i) = delu(i)         u_zref(i) = delu(i)
137         q_zref(i) = max(qsurf(i), 0.0) + delq(i)         q_zref(i) = max(qsurf(i), 0.0) + delq(i)
138         te_zref(i) = ts1(i) + delte(i)         te_zref(i) = ts1(i) + delte(i)
139         temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)         temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
        u_zref_p(i) = u_zref(i)  
140      ENDDO      ENDDO
141    
142      ! Iteration of the variables at the reference level zref:      ! Iteration of the variables at the reference level zref:
143      ! corrector ; see Hess & McAvaney, 1995      ! corrector ; see Hess & McAvaney, 1995
144    
145      DO n = 1, niter      DO n = 1, niter
146         okri=.TRUE.         CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
147         CALL screenc(klon, knon, nsrf, zxli, &              qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
             u_zref, temp, q_zref, zref, &  
             ts1, qsurf, rugos, psol, &  
             ustar, testar, qstar, okri, ri1, &  
             pref, delu, delte, delq)  
148    
149         DO i = 1, knon         DO i = 1, knon
150            u_zref(i) = delu(i)            u_zref(i) = delu(i)
# Line 208  contains Line 155  contains
155      ENDDO      ENDDO
156    
157      DO i = 1, knon      DO i = 1, knon
158         u_zref_c(i) = u_zref(i)         wind10m(i) = u_zref(i)
159           t_10m(i) = temp(i)
160         u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)         q_10m(i) = q_zref(i)
   
        q_zref_c(i) = q_zref(i)  
        temp_c(i) = temp(i)  
        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)  
        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)  
161      ENDDO      ENDDO
162    
163    END subroutine stdlevvar    END subroutine stdlevvar
Legend:
Removed from v.188  
changed lines
  Added in v.286
  ViewVC Help
Powered by ViewVC 1.1.21