source: LMDZ6/branches/DYNAMICO-conv-GC/libf/dyn3d/tetaleveli1j1.F @ 4249

Last change on this file since 4249 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.9 KB
Line 
1c================================================================
2c================================================================
3      SUBROUTINE tetaleveli1j1(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
4c================================================================
5c================================================================
6
7! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
8!      USE dimphy
9      IMPLICIT none
10
11#include "dimensions.h"
12cccc#include "dimphy.h"
13
14c================================================================
15c
16c Interpoler des champs 3-D u, v et g du modele a un niveau de
17c pression donnee (pres)
18c
19c INPUT:  ilon ----- nombre de points
20c         ilev ----- nombre de couches
21c         lnew ----- true si on doit reinitialiser les poids
22c         pgcm ----- pressions modeles
23c         pres ----- pression vers laquelle on interpolle
24c         Qgcm ----- champ GCM
25c         Qpres ---- champ interpolle au niveau pres
26c
27c================================================================
28c
29c   arguments :
30c   -----------
31
32      INTEGER ilon, ilev
33      logical lnew
34
35      REAL pgcm(ilon,ilev)
36      REAL Qgcm(ilon,ilev)
37      real pres
38      REAL Qpres(ilon)
39
40c   local :
41c   -------
42
43cIM 211004
44c     INTEGER lt(klon), lb(klon)
45c     REAL ptop, pbot, aist(klon), aisb(klon)
46c
47#include "paramet.h"
48c
49      INTEGER lt(ip1jmp1), lb(ip1jmp1)
50      REAL ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
51cMI 211004
52      save lt,lb,ptop,pbot,aist,aisb
53
54      INTEGER i, k
55c
56c     PRINT*,'tetalevel pres=',pres
57c=====================================================================
58      if (lnew) then
59c   on réinitialise les réindicages et les poids
60c=====================================================================
61
62
63c Chercher les 2 couches les plus proches du niveau a obtenir
64c
65c Eventuellement, faire l'extrapolation a partir des deux couches
66c les plus basses ou les deux couches les plus hautes:
67      DO 130 i = 1, ilon
68cIM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
69         IF ( ABS(pres-pgcm(i,ilev) ) .GT.
70     .        ABS(pres-pgcm(i,1)) ) THEN
71            lt(i) = ilev     ! 2
72            lb(i) = ilev-1   ! 1
73         ELSE
74            lt(i) = 2
75            lb(i) = 1
76         ENDIF
77cIM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
78cIM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
79  130 CONTINUE
80      DO 150 k = 1, ilev-1
81         DO 140 i = 1, ilon
82            pbot = pgcm(i,k)
83            ptop = pgcm(i,k+1)
84cIM         IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
85            IF (ptop.GE.pres .AND. pbot.LE.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, ilon
95c interpolation en logarithme de pression:
96c
97c ...   Modif . P. Le Van    ( 20/01/98) ....
98c       Modif Frédéric Hourdin (3/01/02)
99
100        IF(pgcm(i,lb(i)).EQ.0.OR.
101     $     pgcm(i,lt(i)).EQ.0.) THEN
102c
103        PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
104     .  lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
105c
106        ENDIF
107c
108        aist(i) = LOG( pgcm(i,lb(i))/ pres )
109     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
110        aisb(i) = LOG( pres / pgcm(i,lt(i)) )
111     .       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
112      enddo
113
114
115      endif ! lnew
116
117c======================================================================
118c    inteprollation
119c======================================================================
120
121      do i=1,ilon
122         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
123cIM      PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
124cIM  $   Qgcm(i,lt(i)),aist(i),Qpres(i)
125      enddo
126c
127c Je mets les vents a zero quand je rencontre une montagne
128      do i = 1, ilon
129cIM      if (pgcm(i,1).LT.pres) THEN
130         if (pgcm(i,1).GT.pres) THEN
131c           Qpres(i)=1e33
132            Qpres(i)=1e+20
133cIM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
134         endif
135      enddo
136
137c
138      RETURN
139      END
Note: See TracBrowser for help on using the repository browser.