source: LMDZ4/branches/pre_V3/libf/dyn3d/tetaleveli1j.F @ 1323

Last change on this file since 1323 was 701, checked in by (none), 19 years ago

This commit was manufactured by cvs2svn to create branch 'pre_V3'.

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