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

Contents of /trunk/phylmd/tetalevel.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 88 - (show annotations)
Tue Mar 11 15:09:02 2014 UTC (10 years, 2 months ago) by guez
File size: 3337 byte(s)
Removed useless argument mode of subroutine read_reanalyse.

1 ! ================================================================
2 ! ================================================================
3 SUBROUTINE tetalevel(ilon, ilev, lnew, pgcm, pres, qgcm, qpres)
4 ! ================================================================
5 ! ================================================================
6
7 USE dimens_m
8 USE paramet_m
9 USE dimphy
10 IMPLICIT NONE
11
12
13 ! ================================================================
14
15 ! Interpoler des champs 3-D u, v et g du modele a un niveau de
16 ! pression donnee (pres)
17
18 ! INPUT: ilon ----- nombre de points
19 ! ilev ----- nombre de couches
20 ! lnew ----- true si on doit reinitialiser les poids
21 ! pgcm ----- pressions modeles
22 ! pres ----- pression vers laquelle on interpolle
23 ! Qgcm ----- champ GCM
24 ! Qpres ---- champ interpolle au niveau pres
25
26 ! ================================================================
27
28 ! arguments :
29 ! -----------
30
31 INTEGER, intent(in):: ilon, ilev
32 LOGICAL lnew
33
34 REAL pgcm(ilon, ilev)
35 REAL, INTENT (IN) :: qgcm(ilon, ilev)
36 REAL, INTENT (IN) :: pres
37 REAL qpres(ilon)
38
39 ! local :
40 ! -------
41
42
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
49 ! PRINT*,'tetalevel pres=',pres
50 ! =====================================================================
51 IF (lnew) THEN
52 ! on réinitialise les réindicages et les poids
53 ! =====================================================================
54
55
56 ! Chercher les 2 couches les plus proches du niveau a obtenir
57
58 ! Eventuellement, faire l'extrapolation a partir des deux couches
59 ! les plus basses ou les deux couches les plus hautes:
60 DO i = 1, ilon
61 IF (abs(pres-pgcm(i,ilev))>abs(pres-pgcm(i,1))) THEN
62 lt(i) = ilev ! 2
63 lb(i) = ilev - 1 ! 1
64 ELSE
65 lt(i) = 2
66 lb(i) = 1
67 END IF
68 END DO
69 DO k = 1, ilev - 1
70 DO i = 1, ilon
71 pbot = pgcm(i, k)
72 ptop = pgcm(i, k+1)
73 ! IM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
74 IF (ptop>=pres .AND. pbot<=pres) THEN
75 lt(i) = k + 1
76 lb(i) = k
77 END IF
78 END DO
79 END DO
80
81 ! Interpolation lineaire:
82
83 DO i = 1, ilon
84 ! interpolation en logarithme de pression:
85
86 ! ... Modif . P. Le Van ( 20/01/98) ....
87 ! Modif Frédéric Hourdin (3/01/02)
88
89 ! IF(pgcm(i,lb(i)).NE.0.OR.
90 ! $ pgcm(i,lt(i)).NE.0.) THEN
91
92 ! PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
93 ! . lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
94
95 aist(i) = log(pgcm(i,lb(i))/pres)/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
96 aisb(i) = log(pres/pgcm(i,lt(i)))/log(pgcm(i,lb(i))/pgcm(i,lt(i)))
97 END DO
98
99
100 END IF ! lnew
101
102 ! ======================================================================
103 ! inteprollation
104 ! ======================================================================
105
106 DO i = 1, ilon
107 qpres(i) = qgcm(i, lb(i))*aisb(i) + qgcm(i, lt(i))*aist(i)
108 END DO
109
110 ! Je mets les vents a zero quand je rencontre une montagne
111 DO i = 1, ilon
112 ! IM if (pgcm(i,1).LT.pres) THEN
113 IF (pgcm(i,1)>pres) THEN
114 ! Qpres(i)=1e33
115 qpres(i) = 1E+20
116 ! IM PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
117 END IF
118 END DO
119
120
121 RETURN
122 END SUBROUTINE tetalevel

  ViewVC Help
Powered by ViewVC 1.1.21