Télécharger ella01.eso

Retour à la liste

Numérotation des lignes :

  1. C ELLA01 SOURCE CHAT 05/01/12 23:33:44 5004
  2. SUBROUTINE ELLA01(NELEXP,NP2,NFRQ,ITEXP,MATRES)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. -INC SMLREEL
  6. -INC SMTABLE
  7. -INC SMELEME
  8. C
  9. POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
  10. C
  11. C LECTURE DE LA TABLE DES ELEMENTS EXPERIMENTAUX
  12. C
  13. C MODULE DECODANT DES LISTES REELLES DE COEFFICIENTS
  14. C EXPERIMENTAUX
  15. C
  16. C TEXP = TABLE 'TAB_EXPERIMENTALE' ;
  17. C
  18. C TLT . MAILLAGE = TABLE 'ELEMENT_EXPERIMENTAL' ;
  19. C TEXP . MAILLAGE = TLT(JELEM) ;
  20. C
  21. C LA LONGUEUR DE LA TABLE TEXP EST EGALE A :
  22. C 1 + NOMBRE D'ELEMENTS EXPERIMENTAUX
  23. C
  24. C POINTEUR DE MOT : MTABII(1)
  25. C POINTEUR DE MAILLAGE DU 1 ER MAILLAGE EXPERIMENTAL : MTABII(2)
  26. C POINTEUR DE MAILLAGE DU 2 EME MAILLAGE EXPERIMENTAL : MTABII(3)
  27. C POINTEUR DE MAILLAGE DU JELEM EME MAILLAGE EXPERIMENTAL : MTABII(JTAB)
  28. C
  29. C POINTEUR DE TABLE DU 1 ER MAILLAGE EXPERIMENTAL : MTABIV(2)
  30. C POINTEUR DE TABLE DU 2 EME MAILLAGE EXPERIMENTAL : MTABIV(3)
  31. C POINTEUR DE TABLE DU JELEM EME MAILLAGE EXPERIMENTAL : MTABIV(JTAB)
  32. C
  33. C 1 < JLIGNE < 14
  34. C TE(JELEM)L(JLIGN) = TABLE 'LIGNE' ;
  35. C TLT(JELEM) . JLIGN = TE(JELEM)L(JLIGN) ;
  36. C
  37. C 1 < JCOLO < 28
  38. C 1 -> RUXA : PARTIE REELLE DE UXA
  39. C 2 -> RUYA
  40. C .........
  41. C JCOLO -> COMP(JCOLO)
  42. C .........
  43. C 28 -> RQTB
  44. C 29 -> IUXA : PARTIE IMAGINAIRE DE UXA
  45. C .........
  46. C JCOLO+28 -> COMP(JCOLO+28)
  47. C .........
  48. C 56 -> IQTB
  49. C
  50. C ENTREES :
  51. C - NELEXP : NOMBRE D'ELEMENTS EXPERIMENTAUX
  52. C - NFRQ : NOMBRE DE POINTS EN FREQUENCE
  53. C - ITEXP : POINTEUR DE LA TABLE : TEXP
  54. C
  55. C SORTIES :
  56. C - MATRES : SEGMENT OU L'ON REMPLIT ALPHAI
  57. C
  58. C VARIABLES LOCALES :
  59. C - PARREE : PARTIE REELLE
  60. C - PARIMA : PARTIE IMAGINAIRE
  61. C POINTEURS :
  62. C - ITAB1 : POINTEUR DE TEXP . MAILLAGE
  63. C - ITAB2 : POINTEUR DE TEXP . MAILLAGE. JLIGN
  64. C - IPOLI1 : POINTEUR DE LISTE REELLE : PARTIE REELLE
  65. C - IPOLI2 : POINTEUR DE LISTE REELLE : PARTIE IMAGINAIRE
  66. C
  67. CHARACTER*4 COMP(56)
  68. CHARACTER*8 CHARI,CHARR,MTYPR
  69. LOGICAL LOGII,LOGIR
  70. REAL*8 PARREE,PARIMA,X0,X1,X2
  71. INTEGER ITEXP,ITAB1,ITAB2,IPOLI1,IPOLI2
  72. C
  73. SEGMENT MATRES
  74. COMPLEX*16 ZA1 (NP28,NP28)
  75. COMPLEX*16 ZSM (NP28)
  76. COMPLEX*16 ZXX (NP28)
  77. COMPLEX*16 ZSOL (NNT14,NFRQ)
  78. REAL*8 COOR (3 ,NP2)
  79. REAL*8 GAMA (3 ,NP)
  80. REAL*8 CARACT(10,NP)
  81. REAL*8 XCL (17 ,NNT)
  82. REAL*8 XCOR (2 , 3 , NBELEM )
  83. REAL*8 VALDE1(2 , NBELEM , 3 )
  84. REAL*8 VALDE2(2 , NBELEM , 3 )
  85. REAL*8 VALDE3(2 , NBELEM , 1 )
  86. REAL*8 VALDE4(2 , NBELEM , 1 )
  87. INTEGER FLAG (NNT17)
  88. INTEGER CORRES(NP2)
  89. INTEGER NUMERO(NNT)
  90. INTEGER MASS (4,NNT)
  91. REAL*8 RMAS (4,NNT)
  92. INTEGER IRAILO(4,NNT)
  93. REAL*8 VALRAI(6,NNT)
  94. INTEGER IPIVO(NP28)
  95. INTEGER JPIVO(NP28)
  96. INTEGER IAUX(NP28)
  97. INTEGER IEXPER(NP)
  98. COMPLEX*16 ALPHAI(14,28,NP,NFRQ)
  99. ENDSEGMENT
  100. C
  101. DATA COMP/'RUXA','RUYA','RUZA','RRXA','RRYA','RRZA',
  102. & 'RFXA','RFYA','RFZA','RMXA','RMYA','RMZA','RPRA','RQTA',
  103. & 'RUXB','RUYB','RUZB','RRXB','RRYB','RRZB',
  104. & 'RFXB','RFYB','RFZB','RMXB','RMYB','RMZB','RPRB','RQTB',
  105. & 'IUXA','IUYA','IUZA','IRXA','IRYA','IRZA',
  106. & 'IFXA','IFYA','IFZA','IMXA','IMYA','IMZA','IPRA','IQTA',
  107. & 'IUXB','IUYB','IUZB','IRXB','IRYB','IRZB',
  108. & 'IFXB','IFYB','IFZB','IMXB','IMYB','IMZB','IPRB','IQTB'/
  109. C
  110. C INITIALISATION
  111. C
  112. CHARI=' '
  113. CHARR=' '
  114. C
  115. C
  116. MTAB1=ITEXP
  117. C
  118. SEGACT MTAB1
  119. C
  120. LONTAB=MTAB1.MLOTAB
  121. C
  122. DO 10 JTAB = 2,LONTAB
  123. C
  124. C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . MAILLAGE : ITAB1
  125. C
  126. IPT5=MTAB1.MTABII(JTAB)
  127. SEGACT IPT5
  128. C
  129. C NOMBRE DE TUYAUX DANS LE MELEME
  130. C
  131. NBEL=IPT5.NUM(/2)
  132. C
  133. C NUMERO DES NOEUDS CONSTITUANT L'ELEMENT POINTE
  134. C
  135. INU1=IPT5.NUM(1,NBEL)
  136. INU2=IPT5.NUM(2,NBEL)
  137. C
  138. C RECHERCHE DU NUMERO DE L'ELEMENT EXPERIMENTAL
  139. C
  140. DO 100 III=1,NP2,2
  141. C
  142. IN1=MATRES.CORRES(III)
  143. IN2=MATRES.CORRES(III+1)
  144. C
  145. IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
  146. NUMEXP=INT(III/2) + 1
  147. END IF
  148. C
  149. IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
  150. NUMEXP=INT(III/2) + 1
  151. END IF
  152. C
  153. 100 CONTINUE
  154. C
  155. SEGDES IPT5
  156. C
  157. C 1 < INP < NP2
  158. C IEXPER(INP) = 0 : TUYAU FORMULATION INTEGRALE
  159. C IEXPER(INP) = 1 : TUYAU FORMULATION EXPERIMENTALE
  160. C IEXPER(INP) EST MIS A EGAL A 1 SI UNIQUEMENT LE MOT VECT EST
  161. C DECODE DANS LE CHAMP DE CARACTERISTIQUES
  162. C
  163. IF (IEXPER(NUMEXP).NE.0) THEN
  164. ITAB1=MTAB1.MTABIV(JTAB)
  165. END IF
  166. C
  167. IF (ITAB1.NE.0) THEN
  168. C
  169. C LE NOM D'UN COMPOSANT EXPERIMENTAL A ETE DETECTE
  170. C
  171. DO 20 JLIGN=1,14
  172. C
  173. C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . MAILLAGE . JLIGN : ITAB2
  174. C
  175. CALL ACCTAB(ITAB1,'ENTIER',JLIGN,X0,CHARI,LOGII,IP0,
  176. & 'TABLE',I1,X1,CHARR,LOGIR,ITAB2)
  177. C
  178. IF (ITAB2.NE.0) THEN
  179. DO 30 JCOLO=1,28
  180. C
  181. C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . JELEM . JLIGN .
  182. C COMP(JCOLO) : IPOLI1 -> CORRESPOND A LA PARTIE REELLE
  183. C
  184. MTYPR=' '
  185. CALL ACCTAB(ITAB2,'MOT',I0,X0,COMP(JCOLO),LOGII,IP0,
  186. & MTYPR,I1,X1,CHARR,LOGIR,IPOLI1)
  187. IF (MTYPR.EQ.'LISTREEL') THEN
  188. C
  189. C LA PARTIE REELLE NON NULLE :
  190. C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . JELEM . JLIGN .
  191. C COMP(JCOLO+28) : IPOLI2 -> CORRESPOND A LA PARTIE IMAGINAIRE
  192. C
  193. MTYPR=' '
  194. CALL ACCTAB(ITAB2,'MOT',I0,X0,COMP(JCOLO+28),LOGII,IP0,
  195. & MTYPR,I1,X1,CHARR,LOGIR,IPOLI2)
  196. IF (MTYPR.EQ.'LISTREEL') THEN
  197. C
  198. C LA PARTIE IMAGINAIRE EST NON NULLE
  199. C
  200. MLREE4=IPOLI1
  201. MLREE5=IPOLI2
  202. SEGACT MLREE4
  203. SEGACT MLREE5
  204. DO 40 JFRQ=1,NFRQ
  205. PARREE=MLREE4.PROG(JFRQ)
  206. PARIMA=MLREE5.PROG(JFRQ)
  207. C
  208. MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)=CMPLX(PARREE,
  209. & PARIMA)
  210. 40 CONTINUE
  211. SEGDES MLREE4
  212. SEGDES MLREE5
  213. C
  214. ELSE
  215. C
  216. PARIMA=0.D0
  217. MLREEL=IPOLI1
  218. SEGACT MLREEL
  219. DO 50 JFRQ=1,NFRQ
  220. PARREE=PROG(JFRQ)
  221. C
  222. MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)=
  223. & CMPLX(PARREE,PARIMA)
  224. C
  225. 50 CONTINUE
  226. SEGDES MLREEL
  227. C
  228. END IF
  229. ELSE
  230. C
  231. C LA PARTIE REELLE EST NULLE
  232. C
  233. PARREE=0.D0
  234. MTYPR=' '
  235. CALL ACCTAB(ITAB2,'MOT',I0,X0,COMP(JCOLO+28),LOGII,IP0,
  236. & MTYPR,I1,X1,CHARR,LOGIR,IPOLI2)
  237. IF (MTYPR.EQ.'LISTREEL') THEN
  238. C
  239. C LA PARTIE IMAGINAIRE EST NON NULLE
  240. C
  241. MLREEL=IPOLI2
  242. SEGACT MLREEL
  243. DO 60 JFRQ=1,NFRQ
  244. PARIMA=PROG(JFRQ)
  245. C
  246. MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)=
  247. & CMPLX(PARREE,PARIMA)
  248. 60 CONTINUE
  249. SEGDES MLREEL
  250. C
  251. ELSE
  252. C
  253. C LA PARTIE IMAGINAIRE EST NULLE
  254. C
  255. PARIMA=0.D0
  256. DO 70 JFRQ=1,NFRQ
  257. MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)=
  258. & CMPLX(PARREE,PARIMA)
  259. 70 CONTINUE
  260. C
  261. END IF
  262. C
  263. END IF
  264. C
  265. 30 CONTINUE
  266. C
  267. END IF
  268. 20 CONTINUE
  269. C
  270. END IF
  271. 10 CONTINUE
  272. C
  273. SEGDES MTAB1
  274. C
  275. RETURN
  276. C
  277. end
  278.  
  279.  
  280.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales