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

Diff of /trunk/Sources/phylmd/screenp.f

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

trunk/phylmd/screenp.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/screenp.f revision 227 by guez, Thu Nov 2 15:47:03 2017 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 et 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, tair, qair
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      ! tair----input-R- temperature de l'air au 1er niveau du modele
29  ! qsurf---input-R- humidite relative a la surface      ! qair----input-R- humidite relative au 1er niveau du modele
30  ! rugos---input-R- rugosite      REAL, dimension(klon), intent(in):: ts, qsurf, rugos
31  ! lmon----input-R- longueur de Monin-Obukov      ! ts------input-R- temperature de l'air a la surface
32  ! ustar---input-R- facteur d'echelle pour le vent      ! qsurf---input-R- humidite relative a la surface
33  ! testar--input-R- facteur d'echelle pour la temperature potentielle      ! rugos---input-R- rugosite
34  ! qstar---input-R- facteur d'echelle pour l'humidite relative      DOUBLE PRECISION, dimension(klon), intent(in):: lmon
35  ! zref----input-R- altitude de reference      ! lmon----input-R- longueur de Monin-Obukov
36  !      REAL, dimension(klon), intent(in):: ustar, testar, qstar
37  ! delu----input-R- anomalie du vent par rapport au 1er niveau      ! ustar---input-R- facteur d'echelle pour le vent
38  ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface      ! testar--input-R- facteur d'echelle pour la temperature potentielle
39  ! delq----input-R- anomalie de l'humidite relative par rapport a la surface      ! qstar---input-R- facteur d'echelle pour l'humidite relative
40  !      REAL, intent(in):: zref
41        INTEGER, intent(in) :: klon, knon, nsrf      ! zref----input-R- altitude de reference
42        REAL, dimension(klon), intent(in) :: speed, tair, qair  
43        REAL, dimension(klon), intent(in) :: ts, qsurf, rugos      REAL, dimension(klon), intent(out):: delu
44        DOUBLE PRECISION, dimension(klon), intent(in) :: lmon      ! delu----input-R- anomalie du vent par rapport au 1er niveau
45        REAL, dimension(klon), intent(in) :: ustar, testar, qstar  
46        REAL, intent(in) :: zref      REAL, dimension(klon), intent(out):: delte
47  !      ! anomalie de la temperature potentielle par rapport a la surface
48        REAL, dimension(klon), intent(out) :: delu, delte, delq  
49  !      REAL, dimension(klon), intent(out):: delq
50  !-------------------------------------------------------------------------      ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
51  ! Variables locales et constantes :  
52        REAL, PARAMETER :: RKAR=0.40      ! Local:
53        INTEGER :: i      REAL, PARAMETER:: RKAR=0.40
54        REAL :: xtmp, xtmp0      INTEGER i
55  !-------------------------------------------------------------------------      REAL xtmp, xtmp0
56        DO i = 1, knon      
57  !      !-------------------------------------------------------------------------
58          IF (lmon(i).GE.0.) THEN      
59  !      DO i = 1, knon
60  ! STABLE CASE         IF (lmon(i) >= 0.) THEN
61  !            ! STABLE CASE
62            IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0) THEN            IF (speed(i) > 1.5.AND.lmon(i) <= 1.0) THEN
63              delu(i) = (ustar(i)/RKAR)* &               delu(i) = (ustar(i)/RKAR)* &
64                        (log(zref/(rugos(i))+1.) + &                    (log(zref/(rugos(i))+1.) + &
65                        min(5d0, 5d0 *(zref - rugos(i))/lmon(i)))                    min(5d0, 5d0 *(zref - rugos(i))/lmon(i)))
66              delte(i) = (testar(i)/RKAR)* &               delte(i) = (testar(i)/RKAR)* &
67                         (log(zref/(rugos(i))+1.) + &                    (log(zref/(rugos(i))+1.) + &
68                         min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))                    min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
69              delq(i) = (qstar(i)/RKAR)* &               delq(i) = (qstar(i)/RKAR)* &
70                        (log(zref/(rugos(i))+1.) + &                    (log(zref/(rugos(i))+1.) + &
71                        min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))                    min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
72            ELSE            ELSE
73              delu(i)  = 0.1 * speed(i)               delu(i) = 0.1 * speed(i)
74              delte(i) = 0.1 * (tair(i) - ts(i) )               delte(i) = 0.1 * (tair(i) - ts(i))
75              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))
76            ENDIF            ENDIF
77          ELSE           ELSE
78  !            ! UNSTABLE CASE
79  ! UNSTABLE CASE            IF (speed(i) > 5.0.AND.abs(lmon(i)) <= 50.0) THEN
80  !               xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
81            IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN               xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
82              xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)               delu(i) = (ustar(i)/RKAR)* &
83              xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)                    (log(zref/(rugos(i))+1.) &
84              delu(i) = (ustar(i)/RKAR)* &                    - 2.*log(0.5*(1. + xtmp)) &
85                        (log(zref/(rugos(i))+1.) &                    + 2.*log(0.5*(1. + xtmp0)) &
86                        - 2.*log(0.5*(1. + xtmp)) &                    - log(0.5*(1. + xtmp*xtmp)) &
87                        + 2.*log(0.5*(1. + xtmp0)) &                    + log(0.5*(1. + xtmp0*xtmp0)) &
88                        - log(0.5*(1. + xtmp*xtmp)) &                    + 2.*atan(xtmp) - 2.*atan(xtmp0))
89                        + log(0.5*(1. + xtmp0*xtmp0)) &               delte(i) = (testar(i)/RKAR)* &
90                        + 2.*atan(xtmp) - 2.*atan(xtmp0))                    (log(zref/(rugos(i))+1.) &
91              delte(i) = (testar(i)/RKAR)* &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
92                         (log(zref/(rugos(i))+1.) &                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
93                         - 2.0 * log(0.5*(1. + xtmp*xtmp)) &               delq(i) = (qstar(i)/RKAR)* &
94                         + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))                    (log(zref/(rugos(i))+1.) &
95              delq(i)  = (qstar(i)/RKAR)* &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
96                         (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)))  
97            ELSE            ELSE
98              delu(i)  = 0.5 * speed(i)               delu(i) = 0.5 * speed(i)
99              delte(i) = 0.5 * (tair(i) - ts(i) )               delte(i) = 0.5 * (tair(i) - ts(i))
100              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))
101            ENDIF            ENDIF
102          ENDIF         ENDIF
103  !      ENDDO
104        ENDDO  
105        RETURN    END SUBROUTINE screenp
106        END SUBROUTINE screenp  
107    end module screenp_m
Legend:
Removed from v.82  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21