source: LMDZ4/trunk/libf/phylmd/plevel.F @ 1351

Last change on this file since 1351 was 1233, checked in by musat, 15 years ago

Pour la coherence avec netcdf : on met les memes _Fillvalue pour les variables a un niveau de pression
IM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1!
2! $Header$
3!
4c================================================================
5c================================================================
6      SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
7c================================================================
8c================================================================
9      USE netcdf
10      USE dimphy
11      IMPLICIT none
12
13cym#include "dimensions.h"
14cy#include "dimphy.h"
15
16c================================================================
17c
18c Interpoler des champs 3-D u, v et g du modele a un niveau de
19c pression donnee (pres)
20c
21c INPUT:  ilon ----- nombre de points
22c         ilev ----- nombre de couches
23c         lnew ----- true si on doit reinitialiser les poids
24c         pgcm ----- pressions modeles
25c         pres ----- pression vers laquelle on interpolle
26c         Qgcm ----- champ GCM
27c         Qpres ---- champ interpolle au niveau pres
28c
29c================================================================
30c
31c   arguments :
32c   -----------
33
34      INTEGER ilon, ilev
35      logical lnew
36
37      REAL pgcm(ilon,ilev)
38      REAL Qgcm(ilon,ilev)
39      real pres
40      REAL Qpres(ilon)
41
42c   local :
43c   -------
44
45cym      INTEGER lt(klon), lb(klon)
46cym      REAL ptop, pbot, aist(klon), aisb(klon)
47
48cym      save lt,lb,ptop,pbot,aist,aisb
49      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:) :: lt,lb
50      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: aist,aisb
51c$OMP THREADPRIVATE(lt,lb,aist,aisb)     
52      REAL,SAVE :: ptop, pbot
53c$OMP THREADPRIVATE(ptop, pbot)     
54      LOGICAL,SAVE :: first = .true.
55c$OMP THREADPRIVATE(first)
56      INTEGER i, k
57c
58      REAL missing_val
59c
60      missing_val=nf90_fill_real
61c
62      if (first) then
63        allocate(lt(klon),lb(klon),aist(klon),aisb(klon))
64        first=.false.
65      endif
66     
67c=====================================================================
68      if (lnew) then
69c   on r�nitialise les r�ndicages et les poids
70c=====================================================================
71
72
73c Chercher les 2 couches les plus proches du niveau a obtenir
74c
75c Eventuellement, faire l'extrapolation a partir des deux couches
76c les plus basses ou les deux couches les plus hautes:
77      DO 130 i = 1, klon
78         IF ( ABS(pres-pgcm(i,ilev) ) .LT.
79     .        ABS(pres-pgcm(i,1)) ) THEN
80            lt(i) = ilev     ! 2
81            lb(i) = ilev-1   ! 1
82         ELSE
83            lt(i) = 2
84            lb(i) = 1
85         ENDIF
86  130 CONTINUE
87      DO 150 k = 1, ilev-1
88         DO 140 i = 1, klon
89            pbot = pgcm(i,k)
90            ptop = pgcm(i,k+1)
91            IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
92               lt(i) = k+1
93               lb(i) = k
94            ENDIF
95  140    CONTINUE
96  150 CONTINUE
97c
98c Interpolation lineaire:
99c
100      DO i = 1, klon
101c interpolation en logarithme de pression:
102c
103c ...   Modif . P. Le Van    ( 20/01/98) ....
104c       Modif Fr��ic Hourdin (3/01/02)
105
106        aist(i) = LOG( pgcm(i,lb(i))/ pres )
107     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
108        aisb(i) = LOG( pres / pgcm(i,lt(i)) )
109     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
110      enddo
111
112
113      endif ! lnew
114
115c======================================================================
116c    inteprollation
117c======================================================================
118
119      do i=1,klon
120         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
121      enddo
122c
123c Je mets les vents a zero quand je rencontre une montagne
124      do i = 1, klon
125         if (pgcm(i,1).LT.pres) THEN
126            Qpres(i)=missing_val
127         endif
128      enddo
129
130c
131      RETURN
132      END
Note: See TracBrowser for help on using the repository browser.