/[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

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

Legend:
Removed from v.177  
changed lines
  Added in v.178

  ViewVC Help
Powered by ViewVC 1.1.21