GCC Code Coverage Report


Directory: ./
File: dyn/tetaleveli1j1.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 30 0.0%
Branches: 0 26 0.0%

Line Branch Exec Source
1 c================================================================
2 c================================================================
3 SUBROUTINE tetaleveli1j1(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 !-----------------------------------------------------------------------
12 ! INCLUDE 'dimensions.h'
13 !
14 ! dimensions.h contient les dimensions du modele
15 ! ndm est tel que iim=2**ndm
16 !-----------------------------------------------------------------------
17
18 INTEGER iim,jjm,llm,ndm
19
20 PARAMETER (iim= 32,jjm=32,llm=39,ndm=1)
21
22 !-----------------------------------------------------------------------
23 cccc#include "dimphy.h"
24
25 c================================================================
26 c
27 c Interpoler des champs 3-D u, v et g du modele a un niveau de
28 c pression donnee (pres)
29 c
30 c INPUT: ilon ----- nombre de points
31 c ilev ----- nombre de couches
32 c lnew ----- true si on doit reinitialiser les poids
33 c pgcm ----- pressions modeles
34 c pres ----- pression vers laquelle on interpolle
35 c Qgcm ----- champ GCM
36 c Qpres ---- champ interpolle au niveau pres
37 c
38 c================================================================
39 c
40 c arguments :
41 c -----------
42
43 INTEGER ilon, ilev
44 logical lnew
45
46 REAL pgcm(ilon,ilev)
47 REAL Qgcm(ilon,ilev)
48 real pres
49 REAL Qpres(ilon)
50
51 c local :
52 c -------
53
54 cIM 211004
55 c INTEGER lt(klon), lb(klon)
56 c REAL ptop, pbot, aist(klon), aisb(klon)
57 c
58 !
59 ! $Header$
60 !
61 !
62 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
63 ! veillez n'utiliser que des ! pour les commentaires
64 ! et bien positionner les & des lignes de continuation
65 ! (les placer en colonne 6 et en colonne 73)
66 !
67 !
68 !-----------------------------------------------------------------------
69 ! INCLUDE 'paramet.h'
70
71 INTEGER iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
72 INTEGER kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
73 INTEGER ijmllm,mvar
74 INTEGER jcfil,jcfllm
75
76 PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3 &
77 & ,jjp1=jjm+1-1/jjm)
78 PARAMETER( llmp1 = llm+1, llmp2 = llm+2, llmm1 = llm-1 )
79 PARAMETER( kftd = iim/2 -ndm )
80 PARAMETER( ip1jm = iip1*jjm, ip1jmp1= iip1*jjp1 )
81 PARAMETER( ip1jmi1= ip1jm - iip1 )
82 PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
83 PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
84 PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
85
86 !-----------------------------------------------------------------------
87 c
88 INTEGER lt(ip1jmp1), lb(ip1jmp1)
89 REAL ptop, pbot, aist(ip1jmp1), aisb(ip1jmp1)
90 cMI 211004
91 save lt,lb,ptop,pbot,aist,aisb
92
93 INTEGER i, k
94 c
95 c PRINT*,'tetalevel pres=',pres
96 c=====================================================================
97 if (lnew) then
98 c on r�initialise les r�indicages et les poids
99 c=====================================================================
100
101
102 c Chercher les 2 couches les plus proches du niveau a obtenir
103 c
104 c Eventuellement, faire l'extrapolation a partir des deux couches
105 c les plus basses ou les deux couches les plus hautes:
106 DO 130 i = 1, ilon
107 cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT.
108 IF ( ABS(pres-pgcm(i,ilev) ) .GT.
109 . ABS(pres-pgcm(i,1)) ) THEN
110 lt(i) = ilev ! 2
111 lb(i) = ilev-1 ! 1
112 ELSE
113 lt(i) = 2
114 lb(i) = 1
115 ENDIF
116 cIM PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)',
117 cIM .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1))
118 130 CONTINUE
119 DO 150 k = 1, ilev-1
120 DO 140 i = 1, ilon
121 pbot = pgcm(i,k)
122 ptop = pgcm(i,k+1)
123 cIM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
124 IF (ptop.GE.pres .AND. pbot.LE.pres) THEN
125 lt(i) = k+1
126 lb(i) = k
127 ENDIF
128 140 CONTINUE
129 150 CONTINUE
130 c
131 c Interpolation lineaire:
132 c
133 DO i = 1, ilon
134 c interpolation en logarithme de pression:
135 c
136 c ... Modif . P. Le Van ( 20/01/98) ....
137 c Modif Fr�d�ric Hourdin (3/01/02)
138
139 IF(pgcm(i,lb(i)).EQ.0.OR.
140 $ pgcm(i,lt(i)).EQ.0.) THEN
141 c
142 PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i),
143 . lt(i),pgcm(i,lb(i)),pgcm(i,lt(i)),pres
144 c
145 ENDIF
146 c
147 aist(i) = LOG( pgcm(i,lb(i))/ pres )
148 . / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
149 aisb(i) = LOG( pres / pgcm(i,lt(i)) )
150 . / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
151 enddo
152
153
154 endif ! lnew
155
156 c======================================================================
157 c inteprollation
158 c======================================================================
159
160 do i=1,ilon
161 Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
162 cIM PRINT*,'i,Qgcm,Qpres',i,Qgcm(i,lb(i)),aisb(i),
163 cIM $ Qgcm(i,lt(i)),aist(i),Qpres(i)
164 enddo
165 c
166 c Je mets les vents a zero quand je rencontre une montagne
167 do i = 1, ilon
168 cIM if (pgcm(i,1).LT.pres) THEN
169 if (pgcm(i,1).GT.pres) THEN
170 c Qpres(i)=1e33
171 Qpres(i)=1e+20
172 cIM PRINT*,'i,pgcm(i,1),pres =',i,pgcm(i,1),pres
173 endif
174 enddo
175
176 c
177 RETURN
178 END
179