/[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 178 by guez, Fri Mar 11 18:47:26 2016 UTC revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 4  module screenp_m Line 4  module screenp_m
4    
5  contains  contains
6    
7    ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/screenp.F90,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $    SUBROUTINE screenp(knon, speed, tair, qair, ts, qsurf, rugos, lmon, ustar, &
8    !         testar, qstar, zref, delu, delte, delq)
9    SUBROUTINE screenp(klon, knon, &  
10         &                   speed, tair, qair, &      ! From LMDZ4/libf/phylmd/screenp.F90, version 1.1.1.1, 2004/05/19 12:53:09
11         &                   ts, qsurf, rugos, lmon, &  
12         &                   ustar, testar, qstar, zref, &      ! Objet : calcul "pr\'edicteur" des anomalies du vent, de la
13         &                   delu, delte, delq)      ! temp\'erature potentielle et de l'humidit\'e relative au niveau
14        ! de r\'ef\'erence zref et par rapport au 1er niveau (pour u) ou
15      ! Objet : calcul "predicteur" des anomalies du vent, de la temperature      ! \`a la surface (pour theta et q) \`a partir des relations de
16      !         potentielle et de l'humidite relative au niveau de reference zref et      ! Dyer-Businger.
17      !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)  
18      !         a partir des relations de Dyer-Businger.      ! Reference: Hess, Colman et McAvaney (1995)
19      !  
     ! Reference : Hess, Colman et McAvaney (1995)  
     !  
20      ! I. Musat, 01.07.2002      ! I. Musat, 01.07.2002
21      !-------------------------------------------------------------------------  
22      !      use dimphy, only: klon
23      ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)  
24        INTEGER, intent(in):: knon
25      ! knon----input-I- nombre de points pour un type de surface      ! knon----input-I- nombre de points pour un type de surface
26        REAL, dimension(klon), intent(in):: speed, tair, qair
27      ! speed---input-R- module du vent au 1er niveau du modele      ! speed---input-R- module du vent au 1er niveau du modele
28      ! tair----input-R- temperature de l'air au 1er niveau du modele      ! tair----input-R- temperature de l'air au 1er niveau du modele
29      ! qair----input-R- humidite relative au 1er niveau du modele      ! qair----input-R- humidite relative au 1er niveau du modele
30        REAL, dimension(klon), intent(in):: ts, qsurf, rugos
31      ! ts------input-R- temperature de l'air a la surface      ! ts------input-R- temperature de l'air a la surface
32      ! qsurf---input-R- humidite relative a la surface      ! qsurf---input-R- humidite relative a la surface
33      ! rugos---input-R- rugosite      ! rugos---input-R- rugosite
34        DOUBLE PRECISION, dimension(klon), intent(in):: lmon
35      ! lmon----input-R- longueur de Monin-Obukov      ! lmon----input-R- longueur de Monin-Obukov
36        REAL, dimension(klon), intent(in):: ustar, testar, qstar
37      ! ustar---input-R- facteur d'echelle pour le vent      ! ustar---input-R- facteur d'echelle pour le vent
38      ! testar--input-R- facteur d'echelle pour la temperature potentielle      ! testar--input-R- facteur d'echelle pour la temperature potentielle
39      ! qstar---input-R- facteur d'echelle pour l'humidite relative      ! qstar---input-R- facteur d'echelle pour l'humidite relative
40        REAL, intent(in):: zref
41      ! zref----input-R- altitude de reference      ! zref----input-R- altitude de reference
42      !  
43        REAL, dimension(klon), intent(out):: delu
44      ! delu----input-R- anomalie du vent par rapport au 1er niveau      ! delu----input-R- anomalie du vent par rapport au 1er niveau
45      ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface  
46        REAL, dimension(klon), intent(out):: delte
47        ! anomalie de la temperature potentielle par rapport a la surface
48    
49        REAL, dimension(klon), intent(out):: delq
50      ! delq----input-R- anomalie de l'humidite relative par rapport a la surface      ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
51      !  
52      INTEGER, intent(in) :: klon, knon      ! Local:
53      REAL, dimension(klon), intent(in) :: speed, tair, qair      REAL, PARAMETER:: RKAR=0.40
54      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos      INTEGER i
55      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon      REAL xtmp, xtmp0
56      REAL, dimension(klon), intent(in) :: ustar, testar, qstar      
     REAL, intent(in) :: zref  
     !  
     REAL, dimension(klon), intent(out) :: delu, delte, delq  
     !  
     !-------------------------------------------------------------------------  
     ! Variables locales et constantes :  
     REAL, PARAMETER :: RKAR=0.40  
     INTEGER :: i  
     REAL :: xtmp, xtmp0  
57      !-------------------------------------------------------------------------      !-------------------------------------------------------------------------
58        
59      DO i = 1, knon      DO i = 1, knon
60         !         IF (lmon(i) >= 0.) THEN
        IF (lmon(i).GE.0.) THEN  
           !  
61            ! STABLE CASE            ! STABLE CASE
62            !            IF (speed(i) > 1.5.AND.lmon(i) <= 1.0) THEN
           IF (speed(i).GT.1.5.AND.lmon(i).LE.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)))
# Line 72  contains Line 70  contains
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            ! UNSTABLE CASE
79            !            IF (speed(i) > 5.0.AND.abs(lmon(i)) <= 50.0) THEN
           IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN  
80               xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)               xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
81               xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)               xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
82               delu(i) = (ustar(i)/RKAR)* &               delu(i) = (ustar(i)/RKAR)* &
83                    (log(zref/(rugos(i))+1.) &                    (log(zref/(rugos(i))+1.) &
84                    - 2.*log(0.5*(1. + xtmp)) &                    - 2.*log(0.5*(1. + xtmp)) &
85                    + 2.*log(0.5*(1. + xtmp0)) &                    + 2.*log(0.5*(1. + xtmp0)) &
86                    - log(0.5*(1. + xtmp*xtmp)) &                    - log(0.5*(1. + xtmp*xtmp)) &
# Line 92  contains Line 88  contains
88                    + 2.*atan(xtmp) - 2.*atan(xtmp0))                    + 2.*atan(xtmp) - 2.*atan(xtmp0))
89               delte(i) = (testar(i)/RKAR)* &               delte(i) = (testar(i)/RKAR)* &
90                    (log(zref/(rugos(i))+1.) &                    (log(zref/(rugos(i))+1.) &
91                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
92                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
93               delq(i)  = (qstar(i)/RKAR)* &               delq(i) = (qstar(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            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      ENDDO
104    
105    END SUBROUTINE screenp    END SUBROUTINE screenp
106    
107  end module screenp_m  end module screenp_m

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

  ViewVC Help
Powered by ViewVC 1.1.21