source: LMDZ6/trunk/libf/dyn3d/tetaleveli1j.f90 @ 5348

Last change on this file since 5348 was 5312, checked in by abarral, 4 weeks ago

.f90 <-> .F90

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