source: LMDZ4/branches/LMDZ4_AR5/libf/phylmd/tetalevel.F @ 2190

Last change on this file since 2190 was 776, checked in by Laurent Fairhead, 17 years ago

Suite du merge entre la version et la HEAD: quelques modifications
de Yann sur le

LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.9 KB
Line 
1!
2! $Header$
3!
4c================================================================
5c================================================================
6      SUBROUTINE tetalevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
7c================================================================
8c================================================================
9      USE dimphy
10      IMPLICIT none
11
12cym#include "dimensions.h"
13cym#include "dimphy.h"
14
15c================================================================
16c
17c Interpoler des champs 3-D u, v et g du modele a un niveau de
18c pression donnee (pres)
19c
20c INPUT:  ilon ----- nombre de points
21c         ilev ----- nombre de couches
22c         lnew ----- true si on doit reinitialiser les poids
23c         pgcm ----- pressions modeles
24c         pres ----- pression vers laquelle on interpolle
25c         Qgcm ----- champ GCM
26c         Qpres ---- champ interpolle au niveau pres
27c
28c================================================================
29c
30c   arguments :
31c   -----------
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
41c   local :
42c   -------
43c
44cym#include "paramet.h"
45c
46      INTEGER,ALLOCATABLE,SAVE :: lt(:), lb(:)
47      REAL,ALLOCATABLE,SAVE    :: aist(:), aisb(:)
48      REAL,SAVE :: ptop, pbot
49      LOGICAL,SAVE :: first = .TRUE.
50c$OMP THREADPRIVATE(lt,lb,aist,aisb,ptop, pbot,first)
51
52      INTEGER i, k
53c
54c     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
61c=====================================================================
62      if (lnew) then
63c   on r�nitialise les r�ndicages et les poids
64c=====================================================================
65
66
67c Chercher les 2 couches les plus proches du niveau a obtenir
68c
69c Eventuellement, faire l'extrapolation a partir des deux couches
70c les plus basses ou les deux couches les plus hautes:
71      DO 130 i = 1, ilon
72cIM      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
81cIM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
82cIM  .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)
88cIM         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
95c
96c Interpolation lineaire:
97c
98      DO i = 1, ilon
99c interpolation en logarithme de pression:
100c
101c ...   Modif . P. Le Van    ( 20/01/98) ....
102c       Modif Fr��ic Hourdin (3/01/02)
103
104c       IF(pgcm(i,lb(i)).NE.0.OR.
105c    $     pgcm(i,lt(i)).NE.0.) THEN
106c
107c       PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
108c    .  lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
109c
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
119c======================================================================
120c    inteprollation
121c======================================================================
122
123      do i=1,ilon
124         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
125cIM      PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
126cIM  $   Qgcm(i,lt(i)),aist(i),Qpres(i)
127      enddo
128c
129c Je mets les vents a zero quand je rencontre une montagne
130      do i = 1, ilon
131cIM      if (pgcm(i,1).LT.pres) THEN
132         if (pgcm(i,1).GT.pres) THEN
133c           Qpres(i)=1e33
134            Qpres(i)=1e+20
135cIM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
136         endif
137      enddo
138
139c
140      RETURN
141      END
Note: See TracBrowser for help on using the repository browser.