My Project
 All Classes Files Functions Variables Macros
tetalevel.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4 c================================================================
5 c================================================================
6  SUBROUTINE tetalevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
7 c================================================================
8 c================================================================
9  USE dimphy
10  IMPLICIT none
11 
12 cym#include "dimensions.h"
13 cym#include "dimphy.h"
14 
15 c================================================================
16 c
17 c Interpoler des champs 3-D u, v et g du modele a un niveau de
18 c pression donnee (pres)
19 c
20 c INPUT: ilon ----- nombre de points
21 c ilev ----- nombre de couches
22 c lnew ----- true si on doit reinitialiser les poids
23 c pgcm ----- pressions modeles
24 c pres ----- pression vers laquelle on interpolle
25 c Qgcm ----- champ GCM
26 c Qpres ---- champ interpolle au niveau pres
27 c
28 c================================================================
29 c
30 c arguments :
31 c -----------
32 
33  INTEGER ilon, ilev
34  logical lnew
35 
36  REAL pgcm(ilon,ilev)
37  REAL qgcm(ilon,ilev)
38  real pres
39  REAL qpres(ilon)
40 
41 c local :
42 c -------
43 c
44 cym#include "paramet.h"
45 c
46  INTEGER,ALLOCATABLE,SAVE :: lt(:), lb(:)
47  REAL,ALLOCATABLE,SAVE :: aist(:), aisb(:)
48  REAL,SAVE :: ptop, pbot
49  LOGICAL,SAVE :: first = .true.
50 c$OMP THREADPRIVATE(lt,lb,aist,aisb,ptop, pbot,first)
51 
52  INTEGER i, k
53 c
54 c PRINT*,'tetalevel pres=',pres
55  IF (first) THEN
56  ALLOCATE(lt(ilon), lb(ilon))
57  ALLOCATE(aist(ilon), aisb(ilon))
58 
59  first=.false.
60  ENDIF
61 c=====================================================================
62  if (lnew) then
63 c on r�nitialise les r�ndicages et les poids
64 c=====================================================================
65 
66 
67 c Chercher les 2 couches les plus proches du niveau a obtenir
68 c
69 c Eventuellement, faire l'extrapolation a partir des deux couches
70 c les plus basses ou les deux couches les plus hautes:
71  DO 130 i = 1, ilon
72 cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT.
73  IF ( abs(pres-pgcm(i,ilev) ) .GT.
74  . abs(pres-pgcm(i,1)) ) THEN
75  lt(i) = ilev ! 2
76  lb(i) = ilev-1 ! 1
77  ELSE
78  lt(i) = 2
79  lb(i) = 1
80  ENDIF
81 cIM PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
82 cIM .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
83  130 CONTINUE
84  DO 150 k = 1, ilev-1
85  DO 140 i = 1, ilon
86  pbot = pgcm(i,k)
87  ptop = pgcm(i,k+1)
88 cIM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
89  IF (ptop.GE.pres .AND. pbot.LE.pres) THEN
90  lt(i) = k+1
91  lb(i) = k
92  ENDIF
93  140 CONTINUE
94  150 CONTINUE
95 c
96 c Interpolation lineaire:
97 c
98  DO i = 1, ilon
99 c interpolation en logarithme de pression:
100 c
101 c ... Modif . P. Le Van ( 20/01/98) ....
102 c Modif Fr��ic Hourdin (3/01/02)
103 
104 c IF(pgcm(i,lb(i)).NE.0.OR.
105 c $ pgcm(i,lt(i)).NE.0.) THEN
106 c
107 c PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
108 c . lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
109 c
110  aist(i) = log( pgcm(i,lb(i))/ pres )
111  . / log( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
112  aisb(i) = log( pres / pgcm(i,lt(i)) )
113  . / log( pgcm(i,lb(i))/ pgcm(i,lt(i)))
114  enddo
115 
116 
117  endif ! lnew
118 
119 c======================================================================
120 c inteprollation
121 c======================================================================
122 
123  do i=1,ilon
124  qpres(i)= qgcm(i,lb(i))*aisb(i)+qgcm(i,lt(i))*aist(i)
125 cIM PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
126 cIM $ Qgcm(i,lt(i)),aist(i),Qpres(i)
127  enddo
128 c
129 c Je mets les vents a zero quand je rencontre une montagne
130  do i = 1, ilon
131 cIM if (pgcm(i,1).LT.pres) THEN
132  if (pgcm(i,1).GT.pres) THEN
133 c Qpres(i)=1e33
134  qpres(i)=1e+20
135 cIM PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
136  endif
137  enddo
138 
139 c
140  RETURN
141  END