source: LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F90 @ 5220

Last change on this file since 5220 was 5159, checked in by abarral, 3 months ago

Put dimensions.h and paramet.h into modules

  • 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.8 KB
Line 
1!================================================================
2!================================================================
3SUBROUTINE tetaleveli1j1(ilon, ilev, lnew, pgcm, pres, Qgcm, Qpres)
4  !================================================================
5  !================================================================
6
7  ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
8USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
9  USE lmdz_paramet
10  IMPLICIT NONE
11
12
13
14  !================================================================
15
16  ! Interpoler des champs 3-D u, v et g du modele a un niveau de
17  ! pression donnee (pres)
18
19  ! INPUT:  ilon ----- nombre de points
20  !     ilev ----- nombre de couches
21  !     lnew ----- true si on doit reinitialiser les poids
22  !     pgcm ----- pressions modeles
23  !     pres ----- pression vers laquelle on interpolle
24  !     Qgcm ----- champ GCM
25  !     Qpres ---- champ interpolle au niveau pres
26
27  !================================================================
28
29  !   arguments :
30  !   -----------
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
40  !   local :
41  !   -------
42
43  !IM 211004
44  ! INTEGER lt(klon), lb(klon)
45  ! REAL ptop, pbot, aist(klon), aisb(klon)
46  !
47
48
49  INTEGER :: lt(ip1jmp1), lb(ip1jmp1)
50  REAL :: ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
51  !MI 211004
52  save lt, lb, ptop, pbot, aist, aisb
53
54  INTEGER :: i, k
55
56  ! PRINT*,'tetalevel pres=',pres
57  !=====================================================================
58  IF (lnew) THEN
59    !   on réinitialise les réindicages et les poids
60    !=====================================================================
61
62
63    ! Chercher les 2 couches les plus proches du niveau a obtenir
64
65    ! Eventuellement, faire l'extrapolation a partir des deux couches
66    ! les plus basses ou les deux couches les plus hautes:
67    DO i = 1, ilon
68      !IM      IF ( ABS(pres-pgcm(i,ilev) ) .LT.
69      IF (ABS(pres - pgcm(i, ilev)) > &
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
77      !IM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
78      !IM  .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
79    END DO
80    DO k = 1, ilev - 1
81      DO i = 1, ilon
82        pbot = pgcm(i, k)
83        ptop = pgcm(i, k + 1)
84        !IM         IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
85        IF (ptop>=pres .AND. pbot<=pres) THEN
86          lt(i) = k + 1
87          lb(i) = k
88        ENDIF
89      END DO
90    END DO
91
92    ! Interpolation lineaire:
93
94    DO i = 1, ilon
95      ! interpolation en logarithme de pression:
96
97      ! ...   Modif . P. Le Van    ( 20/01/98) ....
98      !   Modif Frédéric Hourdin (3/01/02)
99
100      IF(pgcm(i, lb(i))==0.OR. &
101              pgcm(i, lt(i))==0.) THEN
102
103        PRINT*, 'i,lb,lt,2pgcm,pres', i, lb(i), &
104                lt(i), pgcm(i, lb(i)), pgcm(i, lt(i)), pres
105
106      ENDIF
107
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  ENDIF ! 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  enddo
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    endif
134  enddo
135
136  !
137
138END SUBROUTINE tetaleveli1j1
Note: See TracBrowser for help on using the repository browser.