source: LMDZ5/branches/LF-private/libf/phylmd/plevel_new.F @ 3839

Last change on this file since 3839 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

File size: 4.2 KB
Line 
1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/plevel.F,v 1.1.1.1.10.1 2006/08/17 15:41:51 fairhead Exp $
3!
4c================================================================
5c================================================================
6      SUBROUTINE plevel_new(ilon,ilev,klevSTD,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, klevSTD
35      logical lnew
36     
37      REAL pgcm(ilon,ilev)
38      REAL Qgcm(ilon,ilev)
39      real pres(klevSTD)
40      REAL Qpres(ilon, klevSTD)
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.
55      INTEGER :: nlev
56c$OMP THREADPRIVATE(first)
57      INTEGER i, k
58c
59      REAL missing_val
60c
61      missing_val=nf90_fill_real
62c
63      if (first) then
64         allocate(lt(klon,klevSTD),lb(klon,klevSTD))
65         allocate(aist(klon,klevSTD),aisb(klon, klevSTD))
66         first=.false.
67      endif
68     
69c=====================================================================
70      if (lnew) then
71c   on reinitialise les reindicages et les poids
72c=====================================================================
73
74
75c Chercher les 2 couches les plus proches du niveau a obtenir
76c
77c Eventuellement, faire l'extrapolation a partir des deux couches
78c les plus basses ou les deux couches les plus hautes:
79c
80c
81         DO nlev = 1, klevSTD
82            DO i = 1, klon
83               IF ( ABS(pres(nlev)-pgcm(i,ilev) ) .LT.
84     &              ABS(pres(nlev)-pgcm(i,1)) ) THEN
85                  lt(i,nlev) = ilev  ! 2
86                  lb(i,nlev) = ilev-1 ! 1
87               ELSE
88                  lt(i,nlev) = 2
89                  lb(i,nlev) = 1
90               ENDIF
91            ENDDO
92            DO k = 1, ilev-1
93               DO i = 1, klon
94                  pbot = pgcm(i,k)
95                  ptop = pgcm(i,k+1)
96                  IF (ptop.LE.pres(nlev) .AND. pbot.GE.pres(nlev)) THEN
97                     lt(i,nlev) = k+1
98                     lb(i,nlev) = k
99                  ENDIF
100               ENDDO
101            ENDDO
102           
103c     Interpolation lineaire:
104            DO i = 1, klon
105c     interpolation en logarithme de pression:
106c     
107c     ...   Modif . P. Le Van    ( 20/01/98) ....
108c     Modif Frederic Hourdin (3/01/02)
109
110               aist(i,nlev) = LOG( pgcm(i,lb(i,nlev))/ pres(nlev) )
111     &              / LOG( pgcm(i,lb(i,nlev))/ pgcm(i,lt(i,nlev)) )
112               aisb(i,nlev) = LOG( pres(nlev) / pgcm(i,lt(i,nlev)) )
113     &              / LOG( pgcm(i,lb(i,nlev))/ pgcm(i,lt(i,nlev)))
114            ENDDO
115         ENDDO
116
117      ENDIF ! lnew
118
119c======================================================================
120c    inteprollation
121c    ET je mets les vents a zero quand je rencontre une montagne
122c======================================================================
123
124      DO nlev = 1, klevSTD
125         DO i=1,klon
126            IF (pgcm(i,1).LT.pres(nlev)) THEN
127               Qpres(i,nlev) = missing_val
128            ELSE
129               Qpres(i,nlev) =
130     &              Qgcm(i,lb(i,nlev))*aisb(i,nlev) +
131     &              Qgcm(i,lt(i,nlev))*aist(i,nlev)
132            ENDIF
133         ENDDO
134      ENDDO
135
136c     
137      RETURN
138      END
Note: See TracBrowser for help on using the repository browser.