source: LMDZ4/branches/V3_test/libf/phylmd/plevel.F @ 1413

Last change on this file since 1413 was 704, checked in by Laurent Fairhead, 18 years ago

Inclusion des modifs de Y. Meurdesoif pour la version V3
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
RevLine 
[524]1!
2! $Header$
3!
4c================================================================
5c================================================================
6      SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
7c================================================================
8c================================================================
[704]9      USE dimphy
[524]10      IMPLICIT none
11
[704]12cym#include "dimensions.h"
13cy#include "dimphy.h"
[524]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   -------
43
[704]44cym      INTEGER lt(klon), lb(klon)
45cym      REAL ptop, pbot, aist(klon), aisb(klon)
[524]46
[704]47cym      save lt,lb,ptop,pbot,aist,aisb
48      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:) :: lt,lb,aist,aisb
49c$OMP THREADPRIVATE(lt,lb,aist,aisb)     
50      REAL,SAVE :: ptop, pbot
51c$OMP THREADPRIVATE(ptop, pbot)     
52      LOGICAL,SAVE :: first = .true.
53c$OMP THREADPRIVATE(first)
[524]54      INTEGER i, k
55c
[704]56      if (first) then
57        allocate(lt(klon),lb(klon),aist(klon),aisb(klon))
58        first=.false.
59      endif
60     
[524]61c=====================================================================
62      if (lnew) then
[704]63c   on r�nitialise les r�ndicages et les poids
[524]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, klon
72         IF ( ABS(pres-pgcm(i,ilev) ) .LT.
73     .        ABS(pres-pgcm(i,1)) ) THEN
74            lt(i) = ilev     ! 2
75            lb(i) = ilev-1   ! 1
76         ELSE
77            lt(i) = 2
78            lb(i) = 1
79         ENDIF
80  130 CONTINUE
81      DO 150 k = 1, ilev-1
82         DO 140 i = 1, klon
83            pbot = pgcm(i,k)
84            ptop = pgcm(i,k+1)
85            IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
86               lt(i) = k+1
87               lb(i) = k
88            ENDIF
89  140    CONTINUE
90  150 CONTINUE
91c
92c Interpolation lineaire:
93c
94      DO i = 1, klon
95c interpolation en logarithme de pression:
96c
97c ...   Modif . P. Le Van    ( 20/01/98) ....
[704]98c       Modif Fr��ic Hourdin (3/01/02)
[524]99
100        aist(i) = LOG( pgcm(i,lb(i))/ pres )
101     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
102        aisb(i) = LOG( pres / pgcm(i,lt(i)) )
103     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
104      enddo
105
106
107      endif ! lnew
108
109c======================================================================
110c    inteprollation
111c======================================================================
112
113      do i=1,klon
114         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
115      enddo
116c
117c Je mets les vents a zero quand je rencontre une montagne
118      do i = 1, klon
119         if (pgcm(i,1).LT.pres) THEN
120c           Qpres(i)=1e33
121            Qpres(i)=1e+20
122         endif
123      enddo
124
125c
126      RETURN
127      END
Note: See TracBrowser for help on using the repository browser.