GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d/tetaleveli1j.F Lines: 0 30 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 26 0.0 %

Line Branch Exec Source
1
c================================================================
2
c================================================================
3
      SUBROUTINE tetaleveli1j(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
4
c================================================================
5
c================================================================
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"
12
ccccc#include "dimphy.h"
13
14
c================================================================
15
c
16
c Interpoler des champs 3-D u, v et g du modele a un niveau de
17
c pression donnee (pres)
18
c
19
c INPUT:  ilon ----- nombre de points
20
c         ilev ----- nombre de couches
21
c         lnew ----- true si on doit reinitialiser les poids
22
c         pgcm ----- pressions modeles
23
c         pres ----- pression vers laquelle on interpolle
24
c         Qgcm ----- champ GCM
25
c         Qpres ---- champ interpolle au niveau pres
26
c
27
c================================================================
28
c
29
c   arguments :
30
c   -----------
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
c   local :
41
c   -------
42
43
cIM 211004
44
c     INTEGER lt(klon), lb(klon)
45
c     REAL ptop, pbot, aist(klon), aisb(klon)
46
c
47
#include "paramet.h"
48
c
49
      INTEGER lt(ip1jm), lb(ip1jm)
50
      REAL ptop, pbot, aist(ip1jm), aisb(ip1jm)
51
cMI 211004
52
      save lt,lb,ptop,pbot,aist,aisb
53
54
      INTEGER i, k
55
c
56
c     PRINT*,'tetalevel pres=',pres
57
c=====================================================================
58
      if (lnew) then
59
c   on r�initialise les r�indicages et les poids
60
c=====================================================================
61
62
63
c Chercher les 2 couches les plus proches du niveau a obtenir
64
c
65
c Eventuellement, faire l'extrapolation a partir des deux couches
66
c les plus basses ou les deux couches les plus hautes:
67
      DO 130 i = 1, ilon
68
cIM      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
77
cIM   PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
78
cIM  .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)
84
cIM         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
91
c
92
c Interpolation lineaire:
93
c
94
      DO i = 1, ilon
95
c interpolation en logarithme de pression:
96
c
97
c ...   Modif . P. Le Van    ( 20/01/98) ....
98
c       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
102
c
103
        PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
104
     .  lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
105
c
106
        ENDIF
107
c
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
117
c======================================================================
118
c    inteprollation
119
c======================================================================
120
121
      do i=1,ilon
122
         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
123
cIM      PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
124
cIM  $   Qgcm(i,lt(i)),aist(i),Qpres(i)
125
      enddo
126
c
127
c Je mets les vents a zero quand je rencontre une montagne
128
      do i = 1, ilon
129
cIM      if (pgcm(i,1).LT.pres) THEN
130
         if (pgcm(i,1).GT.pres) THEN
131
c           Qpres(i)=1e33
132
            Qpres(i)=1e+20
133
cIM         PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
134
         endif
135
      enddo
136
137
c
138
      RETURN
139
      END