/[lmdze]/trunk/libf/phylmd/tetalevel.f
ViewVC logotype

Annotation of /trunk/libf/phylmd/tetalevel.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 3 months ago) by guez
File size: 3722 byte(s)
Initial import
1 guez 3 c================================================================
2     c================================================================
3     SUBROUTINE tetalevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
4     c================================================================
5     c================================================================
6    
7     use dimens_m
8     use paramet_m
9     use dimphy
10     IMPLICIT none
11    
12    
13     c================================================================
14     c
15     c Interpoler des champs 3-D u, v et g du modele a un niveau de
16     c pression donnee (pres)
17     c
18     c INPUT: ilon ----- nombre de points
19     c ilev ----- nombre de couches
20     c lnew ----- true si on doit reinitialiser les poids
21     c pgcm ----- pressions modeles
22     c pres ----- pression vers laquelle on interpolle
23     c Qgcm ----- champ GCM
24     c Qpres ---- champ interpolle au niveau pres
25     c
26     c================================================================
27     c
28     c arguments :
29     c -----------
30    
31     INTEGER ilon, ilev
32     logical lnew
33    
34     REAL pgcm(ilon,ilev)
35     REAL Qgcm(ilon,ilev)
36     real pres
37     REAL Qpres(ilon)
38    
39     c local :
40     c -------
41     c
42     c
43     INTEGER lt(ip1jmp1), lb(ip1jmp1)
44     REAL ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
45     save lt,lb,ptop,pbot,aist,aisb
46    
47     INTEGER i, k
48     c
49     c PRINT*,'tetalevel pres=',pres
50     c=====================================================================
51     if (lnew) then
52     c on réinitialise les réindicages et les poids
53     c=====================================================================
54    
55    
56     c Chercher les 2 couches les plus proches du niveau a obtenir
57     c
58     c Eventuellement, faire l'extrapolation a partir des deux couches
59     c les plus basses ou les deux couches les plus hautes:
60     DO 130 i = 1, ilon
61     cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT.
62     IF ( ABS(pres-pgcm(i,ilev) ) .GT.
63     . ABS(pres-pgcm(i,1)) ) THEN
64     lt(i) = ilev ! 2
65     lb(i) = ilev-1 ! 1
66     ELSE
67     lt(i) = 2
68     lb(i) = 1
69     ENDIF
70     cIM PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
71     cIM .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
72     130 CONTINUE
73     DO 150 k = 1, ilev-1
74     DO 140 i = 1, ilon
75     pbot = pgcm(i,k)
76     ptop = pgcm(i,k+1)
77     cIM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
78     IF (ptop.GE.pres .AND. pbot.LE.pres) THEN
79     lt(i) = k+1
80     lb(i) = k
81     ENDIF
82     140 CONTINUE
83     150 CONTINUE
84     c
85     c Interpolation lineaire:
86     c
87     DO i = 1, ilon
88     c interpolation en logarithme de pression:
89     c
90     c ... Modif . P. Le Van ( 20/01/98) ....
91     c Modif Frédéric Hourdin (3/01/02)
92    
93     c IF(pgcm(i,lb(i)).NE.0.OR.
94     c $ pgcm(i,lt(i)).NE.0.) THEN
95     c
96     c PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
97     c . lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
98     c
99     aist(i) = LOG( pgcm(i,lb(i))/ pres )
100     . / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
101     aisb(i) = LOG( pres / pgcm(i,lt(i)) )
102     . / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
103     enddo
104    
105    
106     endif ! lnew
107    
108     c======================================================================
109     c inteprollation
110     c======================================================================
111    
112     do i=1,ilon
113     Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
114     cIM PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
115     cIM $ Qgcm(i,lt(i)),aist(i),Qpres(i)
116     enddo
117     c
118     c Je mets les vents a zero quand je rencontre une montagne
119     do i = 1, ilon
120     cIM if (pgcm(i,1).LT.pres) THEN
121     if (pgcm(i,1).GT.pres) THEN
122     c Qpres(i)=1e33
123     Qpres(i)=1e+20
124     cIM PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
125     endif
126     enddo
127    
128     c
129     RETURN
130     END

  ViewVC Help
Powered by ViewVC 1.1.21