/[lmdze]/trunk/phylmd/screenp.f
ViewVC logotype

Diff of /trunk/phylmd/screenp.f

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

trunk/Sources/phylmd/screenp.f revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC trunk/phylmd/screenp.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# Line 1  Line 1 
1  !  module screenp_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/screenp.F90,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $  
3  !    IMPLICIT none
4        SUBROUTINE screenp(klon, knon, nsrf, &  
5       &                   speed, tair, qair, &  contains
6       &                   ts, qsurf, rugos, lmon, &  
7       &                   ustar, testar, qstar, zref, &    SUBROUTINE screenp(knon, speed, tair, qair, ts, qsurf, rugos, lmon, ustar, &
8       &                   delu, delte, delq)         testar, qstar, zref, delu, delte, delq)
9        IMPLICIT none  
10  !-------------------------------------------------------------------------      ! From LMDZ4/libf/phylmd/screenp.F90, version 1.1.1.1, 2004/05/19 12:53:09
11  !  
12  ! Objet : calcul "predicteur" des anomalies du vent, de la temperature      ! Objet : calcul "pr\'edicteur" des anomalies du vent, de la
13  !         potentielle et de l'humidite relative au niveau de reference zref et      ! temp\'erature potentielle et de l'humidit\'e relative au niveau
14  !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)      ! de r\'ef\'erence zref et par rapport au 1er niveau (pour u) ou
15  !         a partir des relations de Dyer-Businger.      ! \`a la surface (pour theta et q) \`a partir des relations de
16  !      ! Dyer-Businger.
17  ! Reference : Hess, Colman et McAvaney (1995)  
18  !      ! Reference: Hess, Colman and McAvaney (1995)
19  ! I. Musat, 01.07.2002  
20  !-------------------------------------------------------------------------      ! I. Musat, 01.07.2002
21  !  
22  ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)      use dimphy, only: klon
23  ! knon----input-I- nombre de points pour un type de surface  
24  ! nsrf----input-I- indice pour le type de surface; voir indicesol.inc      INTEGER, intent(in):: knon
25  ! speed---input-R- module du vent au 1er niveau du modele      ! knon----input-I- nombre de points pour un type de surface
26  ! tair----input-R- temperature de l'air au 1er niveau du modele      REAL, dimension(klon), intent(in):: speed
27  ! qair----input-R- humidite relative au 1er niveau du modele      ! speed---input-R- module du vent au 1er niveau du modele
28  ! ts------input-R- temperature de l'air a la surface      REAL, dimension(klon), intent(in):: tair
29  ! qsurf---input-R- humidite relative a la surface      ! tair----input-R- temperature de l'air au 1er niveau du modele
30  ! rugos---input-R- rugosite      REAL, dimension(klon), intent(in):: qair
31  ! lmon----input-R- longueur de Monin-Obukov      ! qair----input-R- humidite relative au 1er niveau du modele
32  ! ustar---input-R- facteur d'echelle pour le vent      REAL, dimension(klon), intent(in):: ts
33  ! testar--input-R- facteur d'echelle pour la temperature potentielle      ! ts------input-R- temperature de l'air a la surface
34  ! qstar---input-R- facteur d'echelle pour l'humidite relative      REAL, dimension(klon), intent(in):: qsurf
35  ! zref----input-R- altitude de reference      ! qsurf---input-R- humidite relative a la surface
36  !      REAL, dimension(klon), intent(in):: rugos
37  ! delu----input-R- anomalie du vent par rapport au 1er niveau      ! rugos---input-R- rugosite
38  ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface      DOUBLE PRECISION, dimension(klon), intent(in):: lmon
39  ! delq----input-R- anomalie de l'humidite relative par rapport a la surface      ! lmon----input-R- longueur de Monin-Obukov
40  !      REAL, intent(in):: ustar(:) ! (knon) facteur d'\'echelle pour le vent
41        INTEGER, intent(in) :: klon, knon, nsrf      REAL, dimension(klon), intent(in):: testar
42        REAL, dimension(klon), intent(in) :: speed, tair, qair      ! testar--input-R- facteur d'echelle pour la temperature potentielle
43        REAL, dimension(klon), intent(in) :: ts, qsurf, rugos      REAL, dimension(klon), intent(in):: qstar
44        DOUBLE PRECISION, dimension(klon), intent(in) :: lmon      ! qstar---input-R- facteur d'echelle pour l'humidite relative
45        REAL, dimension(klon), intent(in) :: ustar, testar, qstar      REAL, intent(in):: zref
46        REAL, intent(in) :: zref      ! zref----input-R- altitude de reference
47  !  
48        REAL, dimension(klon), intent(out) :: delu, delte, delq      REAL, dimension(klon), intent(out):: delu
49  !      ! delu----input-R- anomalie du vent par rapport au 1er niveau
50  !-------------------------------------------------------------------------  
51  ! Variables locales et constantes :      REAL, dimension(klon), intent(out):: delte
52        REAL, PARAMETER :: RKAR=0.40      ! anomalie de la temperature potentielle par rapport a la surface
53        INTEGER :: i  
54        REAL :: xtmp, xtmp0      REAL, dimension(klon), intent(out):: delq
55  !-------------------------------------------------------------------------      ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
56        DO i = 1, knon  
57  !      ! Local:
58          IF (lmon(i).GE.0.) THEN      REAL, PARAMETER:: RKAR=0.40
59  !      INTEGER i
60  ! STABLE CASE      REAL xtmp, xtmp0
61  !      
62            IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0) THEN      !-------------------------------------------------------------------------
63              delu(i) = (ustar(i)/RKAR)* &      
64                        (log(zref/(rugos(i))+1.) + &      DO i = 1, knon
65                        min(5d0, 5d0 *(zref - rugos(i))/lmon(i)))         IF (lmon(i) >= 0.) THEN
66              delte(i) = (testar(i)/RKAR)* &            ! STABLE CASE
67                         (log(zref/(rugos(i))+1.) + &            IF (speed(i) > 1.5.AND.lmon(i) <= 1.0) THEN
68                         min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))               delu(i) = (ustar(i)/RKAR)* &
69              delq(i) = (qstar(i)/RKAR)* &                    (log(zref/(rugos(i))+1.) + &
70                        (log(zref/(rugos(i))+1.) + &                    min(5d0, 5d0 *(zref - rugos(i))/lmon(i)))
71                        min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))               delte(i) = (testar(i)/RKAR)* &
72                      (log(zref/(rugos(i))+1.) + &
73                      min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
74                 delq(i) = (qstar(i)/RKAR)* &
75                      (log(zref/(rugos(i))+1.) + &
76                      min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
77            ELSE            ELSE
78              delu(i)  = 0.1 * speed(i)               delu(i) = 0.1 * speed(i)
79              delte(i) = 0.1 * (tair(i) - ts(i) )               delte(i) = 0.1 * (tair(i) - ts(i))
80              delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))               delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
81            ENDIF            ENDIF
82          ELSE           ELSE
83  !            ! UNSTABLE CASE
84  ! UNSTABLE CASE            IF (speed(i) > 5.0.AND.abs(lmon(i)) <= 50.0) THEN
85  !               xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
86            IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN               xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
87              xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)               delu(i) = (ustar(i)/RKAR)* &
88              xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)                    (log(zref/(rugos(i))+1.) &
89              delu(i) = (ustar(i)/RKAR)* &                    - 2.*log(0.5*(1. + xtmp)) &
90                        (log(zref/(rugos(i))+1.) &                    + 2.*log(0.5*(1. + xtmp0)) &
91                        - 2.*log(0.5*(1. + xtmp)) &                    - log(0.5*(1. + xtmp*xtmp)) &
92                        + 2.*log(0.5*(1. + xtmp0)) &                    + log(0.5*(1. + xtmp0*xtmp0)) &
93                        - log(0.5*(1. + xtmp*xtmp)) &                    + 2.*atan(xtmp) - 2.*atan(xtmp0))
94                        + log(0.5*(1. + xtmp0*xtmp0)) &               delte(i) = (testar(i)/RKAR)* &
95                        + 2.*atan(xtmp) - 2.*atan(xtmp0))                    (log(zref/(rugos(i))+1.) &
96              delte(i) = (testar(i)/RKAR)* &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
97                         (log(zref/(rugos(i))+1.) &                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
98                         - 2.0 * log(0.5*(1. + xtmp*xtmp)) &               delq(i) = (qstar(i)/RKAR)* &
99                         + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))                    (log(zref/(rugos(i))+1.) &
100              delq(i)  = (qstar(i)/RKAR)* &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
101                         (log(zref/(rugos(i))+1.) &                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
                        - 2.0 * log(0.5*(1. + xtmp*xtmp)) &  
                        + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))  
102            ELSE            ELSE
103              delu(i)  = 0.5 * speed(i)               delu(i) = 0.5 * speed(i)
104              delte(i) = 0.5 * (tair(i) - ts(i) )               delte(i) = 0.5 * (tair(i) - ts(i))
105              delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))               delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
106            ENDIF            ENDIF
107          ENDIF         ENDIF
108  !      ENDDO
109        ENDDO  
110        RETURN    END SUBROUTINE screenp
111        END SUBROUTINE screenp  
112    end module screenp_m

Legend:
Removed from v.134  
changed lines
  Added in v.254

  ViewVC Help
Powered by ViewVC 1.1.21