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

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

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

trunk/libf/phylmd/diagcld2.f90 revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC trunk/Sources/phylmd/diagcld2.f revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 1  Line 1 
1  SUBROUTINE diagcld2(paprs, pplay, t, q, diafra, dialiq)  module diagcld2_m
   
   use dimens_m  
   use dimphy  
   use SUPHEC_M  
   use yoethf_m  
   use fcttre  
2    
3    IMPLICIT none    IMPLICIT none
4    
5    ! Arguments d'entree:  contains
6    REAL, intent(in):: paprs(klon, klev+1) ! pression (Pa) a inter-couche  
7    REAL, intent(in):: pplay(klon, klev) ! pression (Pa) au milieu de couche    SUBROUTINE diagcld2(paprs, pplay, t, q, diafra, dialiq)
8    REAL t(klon, klev) ! temperature (K)  
9    REAL q(klon, klev) ! humidite specifique (Kg/Kg)      USE dimphy, ONLY : klev, klon
10        USE suphec_m, ONLY : rcpd, rd, retv, rtt
11    ! Arguments de sortie:      USE yoethf_m, ONLY : r2es
12    REAL diafra(klon, klev) ! fraction nuageuse diagnostiquee      USE fcttre, ONLY : foeew, qsatl, qsats
13    REAL dialiq(klon, klev) ! eau liquide nuageuse  
14        ! Arguments d'entree:
15    REAL, PARAMETER:: CETAMB = 0.8      REAL, intent(in):: paprs(klon, klev+1) ! pression (Pa) a inter-couche
16    REAL CLOIA, CLOIB, CLOIC, CLOID      REAL, intent(in):: pplay(klon, klev) ! pression (Pa) au milieu de couche
17    PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.6, CLOID=5.0)      REAL, intent(in):: t(klon, klev) ! temperature (K)
18    REAL RGAMMAS      REAL q(klon, klev) ! humidite specifique (Kg/Kg)
19    PARAMETER (RGAMMAS=0.05)  
20    REAL CRHL      ! Arguments de sortie:
21    PARAMETER (CRHL=0.15)      REAL diafra(klon, klev) ! fraction nuageuse diagnostiquee
22    REAL t_coup      REAL dialiq(klon, klev) ! eau liquide nuageuse
23    PARAMETER (t_coup=234.0)  
24        REAL, PARAMETER:: CETAMB = 0.8
25    ! Variables locales:      REAL CLOIA, CLOIB, CLOIC, CLOID
26    INTEGER i, k, kb, invb(klon)      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.6, CLOID=5.0)
27    REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp      REAL RGAMMAS
28    REAL zdelta, zcor      PARAMETER (RGAMMAS=0.05)
29        REAL CRHL
30    !-----------------------------------------------------------      PARAMETER (CRHL=0.15)
31    
32    ! Initialisation:      ! Variables locales:
33        INTEGER i, k, kb, invb(klon)
34    DO k = 1, klev      REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp
35       DO i = 1, klon      REAL zcor
36          diafra(i, k) = 0.0  
37          dialiq(i, k) = 0.0      !-----------------------------------------------------------
38       ENDDO  
39    ENDDO      ! Initialisation:
40    
41    DO i = 1, klon      DO k = 1, klev
42       invb(i) = klev         DO i = 1, klon
43       zdthmin(i)=0.0            diafra(i, k) = 0.0
44    ENDDO            dialiq(i, k) = 0.0
45           ENDDO
46    DO k = 2, klev / 2 - 1      ENDDO
47       DO i = 1, klon  
48          zdthdp = (t(i, k) - t(i, k+1)) / (pplay(i, k) - pplay(i, k+1)) &      DO i = 1, klon
49               - RD * 0.5 * (t(i, k) + t(i, k+1)) / RCPD / paprs(i, k+1)         invb(i) = klev
50          zdthdp = zdthdp * CLOIA         zdthmin(i)=0.0
51          IF (pplay(i, k) > CETAMB * paprs(i, 1) .AND. zdthdp < zdthmin(i)) THEN      ENDDO
52             zdthmin(i) = zdthdp  
53             invb(i) = k      DO k = 2, klev / 2 - 1
54          ENDIF         DO i = 1, klon
55       ENDDO            zdthdp = (t(i, k) - t(i, k+1)) / (pplay(i, k) - pplay(i, k+1)) &
56    ENDDO                 - RD * 0.5 * (t(i, k) + t(i, k+1)) / RCPD / paprs(i, k+1)
57              zdthdp = zdthdp * CLOIA
58    DO i = 1, klon            IF (pplay(i, k) > CETAMB * paprs(i, 1) .AND. zdthdp < zdthmin(i)) THEN
59       kb=invb(i)               zdthmin(i) = zdthdp
60       IF (thermcep) THEN               invb(i) = k
61          zdelta=MAX(0., SIGN(1., RTT-t(i, kb)))            ENDIF
62          zqs= R2ES*FOEEW(t(i, kb), zdelta)/pplay(i, kb)         ENDDO
63          zqs=MIN(0.5, zqs)      ENDDO
64          zcor=1./(1.-RETV*zqs)  
65          zqs=zqs*zcor      DO i = 1, klon
66       ELSE         kb=invb(i)
67          IF (t(i, kb)  <  t_coup) THEN         zqs= R2ES*FOEEW(t(i, kb), RTT >= t(i, kb))/pplay(i, kb)
68             zqs = qsats(t(i, kb)) / pplay(i, kb)         zqs=MIN(0.5, zqs)
69          ELSE         zcor=1./(1.-RETV*zqs)
70             zqs = qsatl(t(i, kb)) / pplay(i, kb)         zqs=zqs*zcor
71          ENDIF         zcll = CLOIB * zdthmin(i) + CLOIC
72       ENDIF         zcll = MIN(1.0, MAX(0.0, zcll))
73       zcll = CLOIB * zdthmin(i) + CLOIC         zrhb= q(i, kb)/zqs
74       zcll = MIN(1.0, MAX(0.0, zcll))         IF (zcll > 0.0.AND.zrhb < CRHL) &
75       zrhb= q(i, kb)/zqs              zcll=zcll*(1.-(CRHL-zrhb)*CLOID)
76       IF (zcll > 0.0.AND.zrhb < CRHL) &         zcll=MIN(1.0, MAX(0.0, zcll))
77            zcll=zcll*(1.-(CRHL-zrhb)*CLOID)         diafra(i, kb) = MAX(diafra(i, kb), zcll)
78       zcll=MIN(1.0, MAX(0.0, zcll))         dialiq(i, kb)= diafra(i, kb) * RGAMMAS*zqs
79       diafra(i, kb) = MAX(diafra(i, kb), zcll)      ENDDO
80       dialiq(i, kb)= diafra(i, kb) * RGAMMAS*zqs  
81    ENDDO    END SUBROUTINE diagcld2
82    
83  END SUBROUTINE diagcld2  end module diagcld2_m
Legend:
Removed from v.51  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21