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

Diff of /trunk/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 246 by guez, Wed Nov 15 13:56:45 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 and 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
27      ! speed---input-R- module du vent au 1er niveau du modele      ! speed---input-R- module du vent au 1er niveau du modele
28        REAL, dimension(klon), intent(in):: tair
29      ! tair----input-R- temperature de l'air au 1er niveau du modele      ! tair----input-R- temperature de l'air au 1er niveau du modele
30        REAL, dimension(klon), intent(in):: qair
31      ! qair----input-R- humidite relative au 1er niveau du modele      ! qair----input-R- humidite relative au 1er niveau du modele
32        REAL, dimension(klon), intent(in):: ts
33      ! ts------input-R- temperature de l'air a la surface      ! ts------input-R- temperature de l'air a la surface
34        REAL, dimension(klon), intent(in):: qsurf
35      ! qsurf---input-R- humidite relative a la surface      ! qsurf---input-R- humidite relative a la surface
36        REAL, dimension(klon), intent(in):: rugos
37      ! rugos---input-R- rugosite      ! rugos---input-R- rugosite
38        DOUBLE PRECISION, dimension(klon), intent(in):: lmon
39      ! lmon----input-R- longueur de Monin-Obukov      ! lmon----input-R- longueur de Monin-Obukov
40      ! ustar---input-R- facteur d'echelle pour le vent      REAL, intent(in):: ustar(:) ! (knon) facteur d'\'echelle pour le vent
41        REAL, dimension(klon), intent(in):: testar
42      ! testar--input-R- facteur d'echelle pour la temperature potentielle      ! testar--input-R- facteur d'echelle pour la temperature potentielle
43        REAL, dimension(klon), intent(in):: qstar
44      ! qstar---input-R- facteur d'echelle pour l'humidite relative      ! qstar---input-R- facteur d'echelle pour l'humidite relative
45        REAL, intent(in):: zref
46      ! zref----input-R- altitude de reference      ! zref----input-R- altitude de reference
47      !  
48        REAL, dimension(klon), intent(out):: delu
49      ! delu----input-R- anomalie du vent par rapport au 1er niveau      ! delu----input-R- anomalie du vent par rapport au 1er niveau
50      ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface  
51        REAL, dimension(klon), intent(out):: delte
52        ! anomalie de la temperature potentielle par rapport a la surface
53    
54        REAL, dimension(klon), intent(out):: delq
55      ! 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
56      !  
57      INTEGER, intent(in) :: klon, knon      ! Local:
58      REAL, dimension(klon), intent(in) :: speed, tair, qair      REAL, PARAMETER:: RKAR=0.40
59      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos      INTEGER i
60      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon      REAL xtmp, xtmp0
61      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  
62      !-------------------------------------------------------------------------      !-------------------------------------------------------------------------
63        
64      DO i = 1, knon      DO i = 1, knon
65         !         IF (lmon(i) >= 0.) THEN
        IF (lmon(i).GE.0.) THEN  
           !  
66            ! STABLE CASE            ! STABLE CASE
67            !            IF (speed(i) > 1.5.AND.lmon(i) <= 1.0) THEN
           IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0) THEN  
68               delu(i) = (ustar(i)/RKAR)* &               delu(i) = (ustar(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)))
# Line 72  contains Line 75  contains
75                    (log(zref/(rugos(i))+1.) + &                    (log(zref/(rugos(i))+1.) + &
76                    min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))                    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            ! UNSTABLE CASE
84            !            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  
85               xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)               xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
86               xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)               xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
87               delu(i) = (ustar(i)/RKAR)* &               delu(i) = (ustar(i)/RKAR)* &
88                    (log(zref/(rugos(i))+1.) &                    (log(zref/(rugos(i))+1.) &
89                    - 2.*log(0.5*(1. + xtmp)) &                    - 2.*log(0.5*(1. + xtmp)) &
90                    + 2.*log(0.5*(1. + xtmp0)) &                    + 2.*log(0.5*(1. + xtmp0)) &
91                    - log(0.5*(1. + xtmp*xtmp)) &                    - log(0.5*(1. + xtmp*xtmp)) &
# Line 92  contains Line 93  contains
93                    + 2.*atan(xtmp) - 2.*atan(xtmp0))                    + 2.*atan(xtmp) - 2.*atan(xtmp0))
94               delte(i) = (testar(i)/RKAR)* &               delte(i) = (testar(i)/RKAR)* &
95                    (log(zref/(rugos(i))+1.) &                    (log(zref/(rugos(i))+1.) &
96                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
97                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
98               delq(i)  = (qstar(i)/RKAR)* &               delq(i) = (qstar(i)/RKAR)* &
99                    (log(zref/(rugos(i))+1.) &                    (log(zref/(rugos(i))+1.) &
100                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &                    - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
101                    + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))                    + 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      ENDDO
109    
110    END SUBROUTINE screenp    END SUBROUTINE screenp
111    
112  end module screenp_m  end module screenp_m
Legend:
Removed from v.178  
changed lines
  Added in v.246
  ViewVC Help
Powered by ViewVC 1.1.21