source: lmdz_wrf/WRFV3/lmdz/plevel.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 3.7 KB
Line 
1!
2! $Header$
3!
4!c================================================================
5!c================================================================
6      SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
7!c================================================================
8!c================================================================
9      USE netcdf
10      USE dimphy
11      IMPLICIT none
12
13!cym#include "dimensions.h"
14!cy#include "dimphy.h"
15
16!c================================================================
17!c
18!c Interpoler des champs 3-D u, v et g du modele a un niveau de
19!c pression donnee (pres)
20!c
21!c INPUT:  ilon ----- nombre de points
22!c         ilev ----- nombre de couches
23!c         lnew ----- true si on doit reinitialiser les poids
24!c         pgcm ----- pressions modeles
25!c         pres ----- pression vers laquelle on interpolle
26!c         Qgcm ----- champ GCM
27!c         Qpres ---- champ interpolle au niveau pres
28!c
29!c================================================================
30!c
31!c   arguments :
32!c   -----------
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
42!c   local :
43!c   -------
44
45!cym      INTEGER lt(klon), lb(klon)
46!cym      REAL ptop, pbot, aist(klon), aisb(klon)
47
48!cym      save lt,lb,ptop,pbot,aist,aisb
49      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:) :: lt,lb
50      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: aist,aisb
51!$OMP THREADPRIVATE(lt,lb,aist,aisb)     
52      REAL,SAVE :: ptop, pbot
53!$OMP THREADPRIVATE(ptop, pbot)     
54      LOGICAL,SAVE :: first = .true.
55!$OMP THREADPRIVATE(first)
56      INTEGER i, k
57!c
58      REAL missing_val
59!c
60      missing_val=nf90_fill_real
61!c
62      if (first) then
63        allocate(lt(klon),lb(klon),aist(klon),aisb(klon))
64        first=.false.
65      endif
66     
67!c=====================================================================
68      if (lnew) then
69!c   on rinitialise les rindicages et les poids
70!c=====================================================================
71
72
73!c Chercher les 2 couches les plus proches du niveau a obtenir
74!c
75!c Eventuellement, faire l'extrapolation a partir des deux couches
76!c 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
97!c
98!c Interpolation lineaire:
99!c
100      DO i = 1, klon
101!c interpolation en logarithme de pression:
102!c
103!c ...   Modif . P. Le Van    ( 20/01/98) ....
104!c       Modif Frederic 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
115!c======================================================================
116!c    inteprollation
117!c======================================================================
118
119      do i=1,klon
120         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
121      enddo
122!c
123!c 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
130!c
131      RETURN
132      END SUBROUTINE plevel
Note: See TracBrowser for help on using the repository browser.