source: LMDZ5/trunk/libf/phylmd/tetalevel.F90 @ 1992

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

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

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