/[lmdze]/trunk/libf/phylmd/Conflx/flxini.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/Conflx/flxini.f90

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

revision 69 by guez, Fri Sep 23 12:28:01 2011 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 1  Line 1 
1        SUBROUTINE flxini(pten, pqen, pqsen, pgeo, paph, pgeoh, ptenh, &  module flxini_m
2                   pqenh, pqsenh, ptu, pqu, ptd, pqd, pmfd, pmfds, pmfdq, &  
3                   pdmfdp, pmfu, pmfus, pmfuq, pdmfup, pdpmel, plu, plude, &    IMPLICIT none
4                   klab,pen_u, pde_u, pen_d, pde_d)  
5        use dimens_m  contains
6        use dimphy  
7        use SUPHEC_M    SUBROUTINE flxini(pten, pqen, pqsen, pgeo, paph, pgeoh, ptenh, pqenh, &
8        use yoethf_m         pqsenh, ptu, pqu, ptd, pqd, pmfd, pmfds, pmfdq, pdmfdp, pmfu, pmfus, &
9        IMPLICIT none         pmfuq, pdmfup, pdpmel, plu, plude, klab,pen_u, pde_u, pen_d, pde_d)
10  !----------------------------------------------------------------------  
11  ! THIS ROUTINE INTERPOLATES LARGE-SCALE FIELDS OF T,Q ETC.      ! This routine interpolates large-scale fields of T,q etc. to half
12  ! TO HALF LEVELS (I.E. GRID FOR MASSFLUX SCHEME),      ! levels (i.e. grid for massflux scheme), and initializes values
13  ! AND INITIALIZES VALUES FOR UPDRAFTS      ! for updrafts.
14  !----------------------------------------------------------------------  
15  !      USE dimphy, ONLY: klev, klon
16        REAL pten(klon,klev)   ! temperature (environnement)      use flxadjtq_m, only: flxadjtq
17        REAL pqen(klon,klev)   ! humidite (environnement)      USE suphec_m, ONLY: rcpd
18        REAL pqsen(klon,klev)  ! humidite saturante (environnement)  
19        REAL pgeo(klon,klev)   ! geopotentiel (g * metre)      REAL, intent(in):: pten(klon,klev)   ! temperature (environnement)
20        REAL pgeoh(klon,klev)  ! geopotentiel aux demi-niveaux      REAL, intent(in):: pqen(klon,klev)   ! humidite (environnement)
21        REAL paph(klon,klev+1) ! pression aux demi-niveaux      REAL, intent(in):: pqsen(klon,klev)  ! humidite saturante (environnement)
22        REAL ptenh(klon,klev)  ! temperature aux demi-niveaux      REAL, intent(in):: pgeo(klon,klev)   ! geopotentiel (g * metre)
23        REAL pqenh(klon,klev)  ! humidite aux demi-niveaux      REAL pgeoh(klon,klev)  ! geopotentiel aux demi-niveaux
24        REAL pqsenh(klon,klev) ! humidite saturante aux demi-niveaux      REAL paph(klon,klev+1) ! pression aux demi-niveaux
25  !      REAL ptenh(klon,klev)  ! temperature aux demi-niveaux
26        REAL ptu(klon,klev)    ! temperature du panache ascendant (p-a)      REAL pqenh(klon,klev)  ! humidite aux demi-niveaux
27        REAL pqu(klon,klev)    ! humidite du p-a      REAL pqsenh(klon,klev) ! humidite saturante aux demi-niveaux
28        REAL plu(klon,klev)    ! eau liquide du p-a      !
29        REAL pmfu(klon,klev)   ! flux de masse du p-a      REAL ptu(klon,klev)    ! temperature du panache ascendant (p-a)
30        REAL pmfus(klon,klev)  ! flux de l'energie seche dans le p-a      REAL pqu(klon,klev)    ! humidite du p-a
31        REAL pmfuq(klon,klev)  ! flux de l'humidite dans le p-a      REAL plu(klon,klev)    ! eau liquide du p-a
32        REAL pdmfup(klon,klev) ! quantite de l'eau precipitee dans p-a      REAL pmfu(klon,klev)   ! flux de masse du p-a
33        REAL plude(klon,klev)  ! quantite de l'eau liquide jetee du      REAL pmfus(klon,klev)  ! flux de l'energie seche dans le p-a
34  !                              p-a a l'environnement      REAL pmfuq(klon,klev)  ! flux de l'humidite dans le p-a
35        REAL pdpmel(klon,klev) ! quantite de neige fondue      REAL pdmfup(klon,klev) ! quantite de l'eau precipitee dans p-a
36  !      REAL plude(klon,klev)  ! quantite de l'eau liquide jetee du
37        REAL ptd(klon,klev)    ! temperature du panache descendant (p-d)      !                              p-a a l'environnement
38        REAL pqd(klon,klev)    ! humidite du p-d      REAL pdpmel(klon,klev) ! quantite de neige fondue
39        REAL pmfd(klon,klev)   ! flux de masse du p-d      !
40        REAL pmfds(klon,klev)  ! flux de l'energie seche dans le p-d      REAL ptd(klon,klev)    ! temperature du panache descendant (p-d)
41        REAL pmfdq(klon,klev)  ! flux de l'humidite dans le p-d      REAL pqd(klon,klev)    ! humidite du p-d
42        REAL pdmfdp(klon,klev) ! quantite de precipitation dans p-d      REAL pmfd(klon,klev)   ! flux de masse du p-d
43  !      REAL pmfds(klon,klev)  ! flux de l'energie seche dans le p-d
44        REAL pen_u(klon,klev) ! quantite de masse entrainee pour p-a      REAL pmfdq(klon,klev)  ! flux de l'humidite dans le p-d
45        REAL pde_u(klon,klev) ! quantite de masse detrainee pour p-a      REAL pdmfdp(klon,klev) ! quantite de precipitation dans p-d
46        REAL pen_d(klon,klev) ! quantite de masse entrainee pour p-d      !
47        REAL pde_d(klon,klev) ! quantite de masse detrainee pour p-d      REAL pen_u(klon,klev) ! quantite de masse entrainee pour p-a
48  !      REAL pde_u(klon,klev) ! quantite de masse detrainee pour p-a
49        INTEGER  klab(klon,klev)      REAL pen_d(klon,klev) ! quantite de masse entrainee pour p-d
50        LOGICAL  llflag(klon)      REAL pde_d(klon,klev) ! quantite de masse detrainee pour p-d
51        INTEGER k, i, icall      !
52        REAL zzs      INTEGER  klab(klon,klev)
53  !----------------------------------------------------------------------      LOGICAL  llflag(klon)
54  ! SPECIFY LARGE SCALE PARAMETERS AT HALF LEVELS      INTEGER k, i, icall
55  ! ADJUST TEMPERATURE FIELDS IF STATICLY UNSTABLE      REAL zzs
56  !----------------------------------------------------------------------      !----------------------------------------------------------------------
57        DO 130 k = 2, klev      ! SPECIFY LARGE SCALE PARAMETERS AT HALF LEVELS
58  !      ! ADJUST TEMPERATURE FIELDS IF STATICLY UNSTABLE
59        DO i = 1, klon      !----------------------------------------------------------------------
60           pgeoh(i,k)=pgeo(i,k)+(pgeo(i,k-1)-pgeo(i,k))*0.5      DO  k = 2, klev
61           ptenh(i,k)=(MAX(RCPD*pten(i,k-1)+pgeo(i,k-1), &         !
62                     RCPD*pten(i,k)+pgeo(i,k))-pgeoh(i,k))/RCPD         DO i = 1, klon
63           pqsenh(i,k)=pqsen(i,k-1)            pgeoh(i,k)=pgeo(i,k)+(pgeo(i,k-1)-pgeo(i,k))*0.5
64           llflag(i)=.TRUE.            ptenh(i,k)=(MAX(RCPD*pten(i,k-1)+pgeo(i,k-1), &
65        ENDDO                 RCPD*pten(i,k)+pgeo(i,k))-pgeoh(i,k))/RCPD
66  !            pqsenh(i,k)=pqsen(i,k-1)
67        icall=0            llflag(i)=.TRUE.
68        CALL flxadjtq(paph(1,k),ptenh(1,k),pqsenh(1,k),llflag,icall)         ENDDO
69  !         !
70        DO i = 1, klon         icall=0
71           pqenh(i,k)=MIN(pqen(i,k-1),pqsen(i,k-1)) &         CALL flxadjtq(paph(1,k),ptenh(1,k),pqsenh(1,k),llflag,icall)
72                       +(pqsenh(i,k)-pqsen(i,k-1))         !
73           pqenh(i,k)=MAX(pqenh(i,k),0.)         DO i = 1, klon
74        ENDDO            pqenh(i,k)=MIN(pqen(i,k-1),pqsen(i,k-1)) &
75  !                 +(pqsenh(i,k)-pqsen(i,k-1))
76    130 CONTINUE            pqenh(i,k)=MAX(pqenh(i,k),0.)
77  !         ENDDO
78        DO 140 i = 1, klon         !
79           ptenh(i,klev)=(RCPD*pten(i,klev)+pgeo(i,klev)- &      end DO
80                           pgeoh(i,klev))/RCPD      !
81           pqenh(i,klev)=pqen(i,klev)      DO  i = 1, klon
82           ptenh(i,1)=pten(i,1)         ptenh(i,klev)=(RCPD*pten(i,klev)+pgeo(i,klev)- &
83           pqenh(i,1)=pqen(i,1)              pgeoh(i,klev))/RCPD
84           pgeoh(i,1)=pgeo(i,1)         pqenh(i,klev)=pqen(i,klev)
85    140 CONTINUE         ptenh(i,1)=pten(i,1)
86  !         pqenh(i,1)=pqen(i,1)
87        DO 160 k = klev-1, 2, -1         pgeoh(i,1)=pgeo(i,1)
88        DO 150 i = 1, klon      end DO
89           zzs = MAX(RCPD*ptenh(i,k)+pgeoh(i,k), &      !
90                     RCPD*ptenh(i,k+1)+pgeoh(i,k+1))      DO  k = klev-1, 2, -1
91           ptenh(i,k) = (zzs-pgeoh(i,k))/RCPD         DO  i = 1, klon
92    150 CONTINUE            zzs = MAX(RCPD*ptenh(i,k)+pgeoh(i,k), &
93    160 CONTINUE                 RCPD*ptenh(i,k+1)+pgeoh(i,k+1))
94  !            ptenh(i,k) = (zzs-pgeoh(i,k))/RCPD
95  !-----------------------------------------------------------------------         end DO
96  ! INITIALIZE VALUES FOR UPDRAFTS AND DOWNDRAFTS      end DO
97  !-----------------------------------------------------------------------      !
98        DO k = 1, klev      !-----------------------------------------------------------------------
99        DO i = 1, klon      ! INITIALIZE VALUES FOR UPDRAFTS AND DOWNDRAFTS
100           ptu(i,k) = ptenh(i,k)      !-----------------------------------------------------------------------
101           pqu(i,k) = pqenh(i,k)      DO k = 1, klev
102           plu(i,k) = 0.         DO i = 1, klon
103           pmfu(i,k) = 0.            ptu(i,k) = ptenh(i,k)
104           pmfus(i,k) = 0.            pqu(i,k) = pqenh(i,k)
105           pmfuq(i,k) = 0.            plu(i,k) = 0.
106           pdmfup(i,k) = 0.            pmfu(i,k) = 0.
107           pdpmel(i,k) = 0.            pmfus(i,k) = 0.
108           plude(i,k) = 0.            pmfuq(i,k) = 0.
109  !            pdmfup(i,k) = 0.
110           klab(i,k) = 0            pdpmel(i,k) = 0.
111  !            plude(i,k) = 0.
112           ptd(i,k) = ptenh(i,k)            !
113           pqd(i,k) = pqenh(i,k)            klab(i,k) = 0
114           pmfd(i,k) = 0.0            !
115           pmfds(i,k) = 0.0            ptd(i,k) = ptenh(i,k)
116           pmfdq(i,k) = 0.0            pqd(i,k) = pqenh(i,k)
117           pdmfdp(i,k) = 0.0            pmfd(i,k) = 0.0
118  !            pmfds(i,k) = 0.0
119           pen_u(i,k) = 0.0            pmfdq(i,k) = 0.0
120           pde_u(i,k) = 0.0            pdmfdp(i,k) = 0.0
121           pen_d(i,k) = 0.0            !
122           pde_d(i,k) = 0.0            pen_u(i,k) = 0.0
123        ENDDO            pde_u(i,k) = 0.0
124        ENDDO            pen_d(i,k) = 0.0
125  !            pde_d(i,k) = 0.0
126        RETURN         ENDDO
127        END      ENDDO
128    
129      END SUBROUTINE flxini
130    
131    end module flxini_m

Legend:
Removed from v.69  
changed lines
  Added in v.70

  ViewVC Help
Powered by ViewVC 1.1.21