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

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

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

trunk/libf/phylmd/coefkz2.f revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/libf/phylmd/coefkz2.f90 revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC
# Line 1  Line 1 
1        SUBROUTINE coefkz2(nsrf, knon, paprs, pplay,t,  SUBROUTINE coefkz2(nsrf, knon, paprs, pplay, t, pcfm, pcfh)
2       .                  pcfm, pcfh)  
3        use dimens_m    ! J'introduit un peu de diffusion sauf dans les endroits
4        use indicesol    ! ou une forte inversion est presente
5        use dimphy    ! On peut dire qu'il represente la convection peu profonde
6        use iniprint  
7        use SUPHEC_M    use dimens_m
8        IMPLICIT none    use indicesol
9  c======================================================================    use dimphy
10  c J'introduit un peu de diffusion sauf dans les endroits    use iniprint
11  c ou une forte inversion est presente    use SUPHEC_M
12  c On peut dire qu'il represente la convection peu profonde  
13  c    IMPLICIT none
14  c Arguments:  
15  c nsrf-----input-I- indicateur de la nature du sol    ! Arguments:
16  c knon-----input-I- nombre de points a traiter    ! nsrf-----input-I- indicateur de la nature du sol
17  c paprs----input-R- pression a chaque intercouche (en Pa)    ! knon-----input-I- nombre de points a traiter
18  c pplay----input-R- pression au milieu de chaque couche (en Pa)    ! paprs----input-R- pression a chaque intercouche (en Pa)
19  c t--------input-R- temperature (K)    ! pplay----input-R- pression au milieu de chaque couche (en Pa)
20  c    ! t--------input-R- temperature (K)
21  c pcfm-----output-R- coefficients a calculer (vitesse)  
22  c pcfh-----output-R- coefficients a calculer (chaleur et humidite)    ! pcfm-----output-R- coefficients a calculer (vitesse)
23  c======================================================================    ! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
24  c  
25  c Arguments:    ! Arguments:
26  c  
27        INTEGER knon, nsrf    INTEGER knon, nsrf
28        REAL paprs(klon,klev+1), pplay(klon,klev)    REAL paprs(klon, klev+1), pplay(klon, klev)
29        REAL t(klon,klev)    REAL t(klon, klev)
30  c  
31        REAL pcfm(klon,klev), pcfh(klon,klev)    REAL pcfm(klon, klev), pcfh(klon, klev)
32  c  
33  c Quelques constantes et options:    ! Quelques constantes et options:
34  c  
35        REAL prandtl    REAL prandtl
36        PARAMETER (prandtl=0.4)    PARAMETER (prandtl=0.4)
37        REAL kstable    REAL kstable
38        PARAMETER (kstable=0.002)    PARAMETER (kstable=0.002)
39  ccc      PARAMETER (kstable=0.001)    REAL mixlen ! constante controlant longueur de melange
40        REAL mixlen ! constante controlant longueur de melange    PARAMETER (mixlen=35.0)
41        PARAMETER (mixlen=35.0)    REAL seuil ! au-dela l'inversion est consideree trop faible
42        REAL seuil ! au-dela l'inversion est consideree trop faible    PARAMETER (seuil=-0.02)
43        PARAMETER (seuil=-0.02)  
44  ccc      PARAMETER (seuil=-0.04)    ! Variables locales:
45  ccc      PARAMETER (seuil=-0.06)  
46  ccc      PARAMETER (seuil=-0.09)    INTEGER i, k, invb(knon)
47  c    REAL zl2(knon)
48  c Variables locales:    REAL zdthmin(knon), zdthdp
49  c  
50        INTEGER i, k, invb(knon)    !----------------------------------------------------------
51        REAL zl2(knon)  
52        REAL zdthmin(knon), zdthdp    ! Initialiser les sorties
53  c    DO k = 1, klev
54  c Initialiser les sorties       DO i = 1, knon
55  c          pcfm(i, k) = 0.0
56        DO k = 1, klev          pcfh(i, k) = 0.0
57        DO i = 1, knon       ENDDO
58           pcfm(i,k) = 0.0    ENDDO
59           pcfh(i,k) = 0.0  
60        ENDDO    ! Chercher la zone d'inversion forte
61        ENDDO  
62  c    DO i = 1, knon
63  c Chercher la zone d'inversion forte       invb(i) = klev
64  c       zdthmin(i)=0.0
65        DO i = 1, knon    ENDDO
66           invb(i) = klev    DO k = 2, klev/ 2 - 1
67           zdthmin(i)=0.0       DO i = 1, knon
68        ENDDO          zdthdp = (t(i, k) - t(i, k + 1)) / (pplay(i, k) - pplay(i, k + 1)) &
69        DO k = 2, klev/2-1               - RD * 0.5 * (t(i, k) + t(i, k + 1)) / RCPD / paprs(i, k + 1)
70        DO i = 1, knon          zdthdp = zdthdp * 100.
71           zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))          IF (pplay(i, k) > 0.8 * paprs(i, 1) .AND. zdthdp < zdthmin(i)) THEN
72       .          - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)             zdthmin(i) = zdthdp
73           zdthdp = zdthdp * 100.0             invb(i) = k
74           IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.          ENDIF
75       .       zdthdp.LT.zdthmin(i) ) THEN       ENDDO
76              zdthmin(i) = zdthdp    ENDDO
77              invb(i) = k  
78           ENDIF    ! Introduire une diffusion:
79        ENDDO    DO k = 2, klev
80        ENDDO       DO i = 1, knon
81  c          ! si on est sur ocean et s'il n'y a pas d'inversion ou si
82  c Introduire une diffusion:          ! l'inversion est trop faible:
83  c          IF ((nsrf.EQ.is_oce) .AND.  &  
84        DO k = 2, klev               ((invb(i).EQ.klev) .OR. (zdthmin(i) > seuil))) THEN
85        DO i = 1, knon             zl2(i)=(mixlen*MAX(0.0, (paprs(i, k)-paprs(i, klev+1)) &
86  cIM cf FH/GK   IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean                  /(paprs(i, 2)-paprs(i, klev+1))))**2
87  cIM cf FH/GK  .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion             pcfm(i, k)= zl2(i)* kstable
88        !IM cf JLD/ GKtest TERkz2             pcfh(i, k) = pcfm(i, k) /prandtl ! h et m different
89        ! IF ( (nsrf.EQ.is_ter) .OR.  ! si on est sur la terre          ENDIF
90        ! fin GKtest       ENDDO
91        IF ( (nsrf.EQ.is_oce) .AND.  ! si on est sur ocean et si    ENDDO
92       .     ( (invb(i).EQ.klev) .OR.      ! s'il n'y a pas d'inversion  
93       .     (zdthmin(i).GT.seuil) ) )THEN ! si l'inversion est trop faible  END SUBROUTINE coefkz2
          zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,klev+1))  
      .                       /(paprs(i,2)-paprs(i,klev+1)) ))**2  
          pcfm(i,k)= zl2(i)* kstable  
          pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different  
       ENDIF  
       ENDDO  
       ENDDO  
 c  
       RETURN  
       END  
Legend:
Removed from v.38  
changed lines
  Added in v.51
  ViewVC Help
Powered by ViewVC 1.1.21