Télécharger ella00.eso

Retour à la liste

Numérotation des lignes :

  1. C ELLA00 SOURCE PV 11/03/07 21:16:40 6885
  2. SUBROUTINE ELLA00
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Y)
  6. IMPLICIT COMPLEX*16 (Z)
  7. C
  8. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  9. C A 11 27 04 4 90
  10. C OPERATEUR ELFE LAPLACE ACOU
  11. C
  12. C CALCUL DES FONCTIONS DE TRANSFERT D'UN RESEAU DE TUYAUTERIES
  13. C CONTENANT UN FLUIDE SANS ECOULEMENT PAR LA METHODE DITE "INTEGRALE".
  14. C LA SYNTAXE EST LA SUIVANTE :
  15. C
  16. C EVOL = ELFE LAPLACE POUTRE ACOU GEO1 (GEO2) CHP1 CHAM1 LFR S0 PT
  17. C COMP IMETH (IMP)
  18. C
  19. C
  20. C ELFE .............. MOT DESIGNANT L'OPERATEUR
  21. C
  22. C LAPLACE, ACOU ..... MOTS CLES POUR L'OPTION DE ELFE( CALCUL ACOUSTO-
  23. C MECANIQUE)
  24. C
  25. C GEO1 .............. OBJET TYPE MAILLAGE DONNANT LE RESEAU DE POUTRES
  26. C
  27. C GEO2 (FACULTATIF).. OBJET TYPE MAILLAGE POUR L'OPTION DONNANT LE
  28. C CHPOINT CONTENANT DEFORMATIONS ET PRESSIONS
  29. C
  30. C CHP1 .............. OBJET TYPE CHPOINT DONNANT LES COND. AUX LIMITES
  31. C
  32. C CHAM1 ............. OBJET TYPE NOUVEAU CHAMELEM POUR LES CARACT.
  33. C DU MATERIAU ET DU FLUIDE
  34. C
  35. C LFR ............... OBJET TYPE LISTREEL DEFINISSANT LES FREQUENCES
  36. C
  37. C S0 ............... OBJET TYPE REEL POUR LA TRANSFORMEE DE LAPLACE
  38. C
  39. C PT ................ OBJET TYPE POINT OU L'ON DESIRE LE DEPLACEMENT
  40. C
  41. C COMP .............. OBJET TYPE CHAR*2 DESIGNANT 'UX','UY' OU 'UZ'
  42. C 'RX','RY' OU 'RZ'
  43. C
  44. C IMETH ............. ENTIER : CHOIX DE LA METHODE DE RESOLUTION
  45. C
  46. C IMP (FALCULTATIF).. ENTIER : <>0 POUR IMPRESSION INTERMEDIAIRE
  47. C
  48. C
  49. C PARAMETRES :
  50. C ('NEANT')
  51. C
  52. C SORTIES :
  53. C
  54. C EVOLUTION --------> SI ON DESIRE LA FONCTION DE TRANSFERT
  55. C
  56. C CHAMPOINT --------> SI ON DESIRE LES VALEURS -DES DEPLACEMENTS
  57. C -DES PRESSIONS
  58. C EN MODULE ET EN PHASE AUX DIFFERENTS NOEUDS.
  59. C
  60. C
  61. C *****************************************************
  62. C * *
  63. C * Organigramme d'appel des diff{rentes SUBROUTINE *
  64. C * *
  65. C *****************************************************
  66. C
  67. C
  68. C ELLA00 (INTERFACE ESOPE <--> FORTRAN)
  69. C |
  70. C |
  71. C |-----> ELLA09 (CONVERSION DE UX , UY ... EN 1 , 2 , ...
  72. C |
  73. C |-----> ELLA08 (CONVERSION DE YOUN , NU ... EN 1 , 2 , ...)
  74. C |
  75. C |
  76. C |-----> ELLA11 (PROGRAMME PRINCIPAL FORTRAN)
  77. C |
  78. C |
  79. C |-----> ELLA12 (REMPLISSAGE DE LA 2}ME PARTIE DE ZA1
  80. C | qui ne d{pend pas de w)
  81. C |
  82. C |-----> ELLA21 (DETERMINATION, POUR CHAQUE POUTRE ET
  83. C | chaque frequence, de la matrice ZC1)
  84. C |
  85. C |
  86. C |-----> ELLA31 (VALEUR DES FCTS DE GREEN)
  87. C |
  88. C |<--------|
  89. C |
  90. C |
  91. C |-----> ELLA51 (RESOLUTION DU SYSTEME LIN{AIRE)
  92. C | (ELLA53)
  93. C |
  94. C |
  95. C |<--------|
  96. C |
  97. C |-----> ELLA23 (D{TERMINATION DES D{PLACEMENTS AUX NOEUDS DU
  98. C | sous-maillage dans le cas du calcul de la
  99. C | d{form{e )
  100. C |
  101. C | -------------
  102. C | | |
  103. C |--------------->| FIN |
  104. C | |
  105. C -------------
  106. C
  107. C AUTEURS : SAINT-DIZIER ET GORCY
  108. C DATE : 23 JANVIER 1991
  109. C
  110. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  111. C
  112. CHARACTER*4 COMP,CHAR
  113. C
  114. -INC CCREEL
  115. -INC CCOPTIO
  116. -INC SMCOORD
  117. -INC SMELEME
  118. -INC SMCHPOI
  119. -INC SMCHAML
  120. -INC SMLREEL
  121. -INC SMEVOLL
  122. C
  123. C ------------------- DIMENSIONNEMENT DES MATRICES CREEES LORS DE
  124. C CETTE INTERFACE FORTRAN <--> ESOPE
  125. C
  126. SEGMENT MATRES
  127. COMPLEX*16 ZA1 (NP28,NP28)
  128. COMPLEX*16 ZSM (NP28)
  129. COMPLEX*16 ZXX (NP28)
  130. COMPLEX*16 ZSOL (NNT14,NFRQ)
  131. REAL*8 COOR (3 ,NP2)
  132. REAL*8 GAMA (3 ,NP)
  133. REAL*8 CARACT(10,NP)
  134. REAL*8 XCL (17 ,NNT)
  135. REAL*8 XCOR (2 , 3 , NBELEM )
  136. REAL*8 VALDE1(2 , NBELEM , 3 )
  137. REAL*8 VALDE2(2 , NBELEM , 3 )
  138. REAL*8 VALDE3(2 , NBELEM , 1 )
  139. REAL*8 VALDE4(2 , NBELEM , 1 )
  140. INTEGER FLAG (NNT17)
  141. INTEGER CORRES(NP2)
  142. INTEGER NUMERO(NNT)
  143. INTEGER MASS (4,NNT)
  144. REAL*8 RMAS (4,NNT)
  145. INTEGER IRAILO(4,NNT)
  146. REAL*8 VALRAI(6,NNT)
  147. INTEGER IPIVO(NP28)
  148. INTEGER JPIVO(NP28)
  149. INTEGER IAUX(NP28)
  150. INTEGER IEXPER(NP)
  151. COMPLEX*16 ALPHAI(14,28,NP,NFRQ)
  152. ENDSEGMENT
  153. C
  154. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  155. C
  156. C EXPLICATION DE CES VARIABLES
  157. C ----------------------------
  158. C
  159. C NP : NOMBRE TOTAL DE POUTRES DU MAILLAGE
  160. C
  161. C NP2 : NP * 2
  162. C
  163. C NP10 : NP * 10
  164. C
  165. C NP28 : NP * 28
  166. C
  167. C NNT : NOMBRE TOTAL DE NOEUDS DU MAILLAGE
  168. C
  169. C NNT14 : NNT * 14
  170. C
  171. C NNT17 : NNT * 17
  172. C
  173. C NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
  174. C
  175. C ---------------------------------------------------------------------
  176. C
  177. C .................... ZA1 : MATRICE DE RESOLUTION
  178. C
  179. C .................... ZSM : VECTEUR SECOND MEMBRE
  180. C
  181. C .................... ZXX : VECTEUR INCONNU
  182. C
  183. C ZXX CONTIENT, POUR LES 2NP NOEUDS, DANS L'ORDRE SUIVANT :
  184. C
  185. C UX UY UZ RX RY RZ FX FY FZ MX MY MZ P Q
  186. C
  187. C
  188. C .................... ZSOL : TABLEAU SOLUTION POUR TOUTES LES FREQ.
  189. C
  190. C
  191. C .................... COOR : TABLEAU DES COORDONNEES
  192. C
  193. C UNE POUTRE COMPORTE 2 NOEUDS (P1 ET P2) --> 2*NP NOEUDS FICTIFS
  194. C
  195. C | COOR(1,2*INP-1) | COOR(1,2*INP)
  196. C P1 | COOR(2,2*INP-1) P2 | COOR(2,2*INP)
  197. C | COOR(3,2*INP-1) | COOR(3,2*INP)
  198. C
  199. C ---------------------------------------------------------------------
  200. C
  201. C .................... GAMA : VECTEUR DEFINISSANT L'AXE OY
  202. C POUR CHAQUE POUTRE
  203. C
  204. C
  205. C .................... CARACT : TABLEAU DES CARACTERISTIQUES
  206. C
  207. C CARACT EST UNE MATRICE (10,NP) QUI, POUR TOUTES LES NP POUTRES,
  208. C DONNE LES CARACTERISTIQUES GEOMETRIQUES ET PHYSIQUE DE LA POUTRE :
  209. C
  210. C CARACT( 1,INP) --> MODULE D'YOUNG : E
  211. C CARACT( 2,INP) --> COEFICIENT DE POISSON : NU
  212. C CARACT( 3,INP) --> MASSE VOLUMIQUE DU MATERIAU : RHO
  213. C CARACT( 4,INP) --> RAYON INTERIEUR : RINT
  214. C CARACT( 5,INP) --> RAYON EXTERIEUR : REXT
  215. C CARACT( 6,INP) --> CONSTANTE DE TIMOSHENKO : KCYZ
  216. C CARACT( 7,INP) --> COEFF. D'AMORTISSEMENT EXTERNE : CAM
  217. C CARACT( 8,INP) --> COEFF. D'AMORTISSEMENT INTERNE : ETA
  218. C CARACT( 9,INP) --> MASSE VOLUMIQUE DU FLUIDE : RHOF
  219. C CARACT(10,INP) --> VITESSE DU SON : CSON
  220. C
  221. C ---------------------------------------------------------------------
  222. C
  223. C .................... XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
  224. C AUX LIMITES POUR CHAQUE NOEUD.
  225. C
  226. C XCL (K,NN) = VALEUR DE LA CONDITION K AU NOEUD REEL NN
  227. C LES CONDITIONS K CORRESPONDENT RESPECTIVEMENT A UX, UY, UZ, RX,
  228. C RY, RZ, FX, FY, FZ, MX, MY, MZ, DP, DQ, A, B, R
  229. C ( IMPEDANCE ACOUSTIQUE: AP + BQ = R )
  230. C
  231. C CHAQUE NOEUD AYANT SOIT LES DEPLACEMENTS, SOIT LES EFFORTS, SOIT
  232. C UNE SOURCE OU UNE IMPEDANCE ACOUSTIQUE, SOIT RIEN DU TOUTD'IMPOSE,
  233. C IL CONVIENT DE DEFINIR UN VECTEUR JOUANT LE ROLE DEPOINTEUR SUR
  234. C XCL QUE L'ON APPELLE FLAG DE LONGUEUR 17*NNT.
  235. C
  236. C LES DIFFERENTS BLOCS DE 17 VALEURS POINTENT SUR LE NOEUD CORRES-
  237. C PONDANT :
  238. C
  239. C LA VALEUR DE FLAG VAUT LE NUMERO DU NOEUD SI ON IMPOSE LA CONDITION
  240. C ELLE VAUT 0 SINON.
  241. C
  242. C ---------------------------------------------------------------------
  243. C
  244. C .................... CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
  245. C
  246. C CHAQUE NOEUD FICTIF EST ASSOCIE A UN NOEUD REEL ; LE TABLEAU CORRES
  247. C DONNE, POUR CHAQUE NOEUD FICTIF (2*NP), LE NUMERO DU NOEUD REEL AS-
  248. C SOCIE.
  249. C
  250. C ---------------------------------------------------------------------
  251. C
  252. C
  253. C .................... NUMERO : TABLEAU DE NUMERO DE NOEUDS
  254. C
  255. C NUMERO (I) = NUMERO GIBI DU IEME NOEUD ( 1 < I < N )
  256. C
  257. C LA NUMEROTATION DE 1 A N EST ARBITRAIREMENT SELON LES NUMEROS
  258. C CROISSANTS DANS GIBI.
  259. C
  260. C
  261. C .................... MASS : TABLEAU DONNANT POUR CHAQUE MASSE
  262. C PONCTUELLE :
  263. C
  264. C - MASS(1,NNT) ... NUMERO DU NOEUD OU S'APPLIQUE LA MASSE
  265. C - MASS(2,NNT) ... NUMERO DE LA POUTREASSOCIEE
  266. C - MASS(3,NNT) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
  267. C DANS LE VECTEUR DES INCONNUS
  268. C - MASS(4,NNT) ... NUMERO DE LIGNE DE LA COMPOSANTE FX DU
  269. C NOEUD OU S'APPLIQUE LA MASSE
  270. C
  271. C .................... RMAS : TABLEAU DONNANT POUR LE NOEUD
  272. C CORRESPONDANT LA VALEUR DE LA MASSE
  273. C DE J0X
  274. C DE J0Y
  275. C DE J0Z
  276. C-----------------------------------------------------------------------
  277. C
  278. C...................... IRAILO : TABLEAU DONNANT POUR CHAQUE RAIDEUR
  279. C LOCALISEE
  280. C
  281. C - IRAILO(1,NNT) ... NUMERO DU NOEUD OU S'APPLIQUE LA RAIDEUR
  282. C - IRAILO(2,NNT) ... NUMERO DE LA POUTRE ASSOCIEE
  283. C - IRAILO(3,NNT) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
  284. C DANS LE VECTEUR DES INCONNUES
  285. C - IRAILO(4,NNT) ... NUMERO DE LIGNE DE LA COMPOSANTE FX DU
  286. C NOEUD OU S'APPLIQUE LA RAIDEUR
  287. C
  288. C...................... VALRAI : TABLEAU DONNANT LA VALEUR DES RAIDEURS
  289. C LOCALISEES
  290. C
  291. C - VALRAI(1,NNT) ... KX
  292. C - VALRAI(2,NNT) ... KY
  293. C - VALRAI(3,NNT) ... KZ
  294. C - VALRAI(4,NNT) ... CX RAISEUR EN TORSION
  295. C - VALRAI(5,NNT) ... CY RAIDEUR EN FLEXION SUIVANT OY
  296. C - VALRAI(6,NNT) ... CZ RAIDEUR EN FLEXION SUIVANT OZ
  297. C
  298. C ........... IPIVO,JPIVO,IAUX : TABLEAU INTERMEDIAIRE DE MEMORISATION
  299. C DE LA TRIANGULARISATION DE GAUSS
  300. C
  301. C
  302. C ..................... VALDE1 : TABLEAU DONNANT POUR CHAQUE ELEMENT
  303. C DU SOUS MAILLAGE LE MODULE DU DEPLA-
  304. C CEMENT
  305. C
  306. C ..................... VALDE2 : TABLEAU DONNANT POUR CHAQUE ELEMENT
  307. C DU SOUS MAILLAGE LA PHASE DU DEPLA-
  308. C CEMENT
  309. C
  310. C
  311. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  312. C
  313. C ------------------- DIMENSIONNEMENT DES MATRICES AUXILIAIRES
  314. C ----------------------------------------
  315. C
  316. SEGMENT AUXI
  317. INTEGER IAUXI(NNNP)
  318. ENDSEGMENT
  319. C
  320. C -------------------- LECTURE DES OBJETS MAILLAGE CHPOINT ET LISTREEL
  321. C -----------------------------------------------
  322. C
  323. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  324. IF (IERR.NE.0) RETURN
  325. C
  326. CALL LIROBJ('MAILLAGE',IPT4,0,IRETOU)
  327. IF (IERR.NE.0) RETURN
  328. IF (IRETOU.NE.0) THEN
  329. IDEPL = 1
  330. SEGACT IPT4
  331. NBELEM = IPT4.NUM(/2)
  332. ELSE
  333. IDEPL = 0
  334. NBELEM = 1
  335. END IF
  336. C
  337. CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
  338. IF (IERR.NE.0) RETURN
  339. C
  340. CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
  341. IF (IERR.NE.0) RETURN
  342. C
  343. C DECODAGE DE LA TABLE TEXP
  344. C
  345. CALL LIRTAB('TAB_EXPERIMENTALE',ITEXP,0,IRETOU)
  346. IF (IERR.NE.0) RETURN
  347. C
  348. CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
  349. IF (IERR.NE.0) RETURN
  350. C
  351. CALL LIRREE(S0,1,IRETOU)
  352. IF (IERR.NE.0) RETURN
  353. C
  354. CALL LIROBJ('POINT',NPOI,1,IRETOU)
  355. IF (IERR.NE.0) RETURN
  356. C
  357. CALL LIRCHA(CHAR,1,LCHAR)
  358. IF (IERR.NE.0) RETURN
  359. C
  360. CALL ELLA09(CHAR,ICHAR,IERROR)
  361. C
  362. C
  363. METH= 2
  364. C
  365. imp = 0
  366. IF (iimpi .eq. 333) imp = ioimp
  367. C
  368. C
  369. C -------------------- ACTIVATION DES SEGMENTS
  370. C -----------------------
  371. SEGACT IPT1
  372. SEGACT MLREE1
  373. SEGACT MCHPO1
  374. SEGACT MCHEL1
  375. C
  376. C
  377. C **********************************************************************
  378. C LECTURE DU MAILLAGE
  379. C **********************************************************************
  380. C
  381. C ..................NP : NOMBRE DE POUTRES DU MAILLAGE
  382. C
  383. NP = IPT1.NUM(/2)
  384. C
  385. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  386. C
  387. IF (IMP.NE.0) THEN
  388. WRITE (IMP,*) 'NOMBRE DE POUTRES DU MAILLAGE :',NP
  389. END IF
  390. C
  391. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  392. C
  393. NN = IPT1.NUM(/1)
  394. C
  395. C --------------------- NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
  396. C
  397. NFRQ = MLREE1.PROG(/1)
  398. C
  399. IF (IDEPL.EQ.1.AND.NFRQ.NE.1) THEN
  400. RETURN
  401. END IF
  402. C
  403. C
  404. C --------------------- DETERMINATION DU NOMBRE DE NOEUDS DU MAILLAGE
  405. C ---------------------------------------------
  406. NNNP = NN*NP
  407. SEGINI AUXI
  408. ICOMP = 0
  409. DO 10 I = 1 , NP
  410. DO 11 J = 1 , NN
  411. AUXI.IAUXI(ICOMP+1) = IPT1.NUM(J,I)
  412. C
  413. IF (ICOMP.LT.1) THEN
  414. ITEST = 0
  415. GOTO 13
  416. END IF
  417. C
  418. ITEST = 0
  419. DO 12 K = 1 , ICOMP
  420. IF (AUXI.IAUXI(K).EQ.IPT1.NUM(J,I)) ITEST = 1
  421. 12 CONTINUE
  422. C
  423. 13 IF (ITEST.EQ.0) ICOMP = ICOMP + 1
  424. C
  425. 11 CONTINUE
  426. C
  427. 10 CONTINUE
  428. C
  429. SEGSUP AUXI
  430. C
  431. NNT = ICOMP
  432. C
  433. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  434. C
  435. IF (IMP.NE.0) THEN
  436. WRITE (IMP,*) 'NOMBRE TOTAL DE NOEUD DU MAILLAGE :',NNT
  437. END IF
  438. C
  439. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  440. C
  441. C --------------------- INITIALISATION DES TABLEAUX DE TRAVAIL
  442. C --------------------------------------
  443. NP2 = NP * 2
  444. NP10 = NP * 10
  445. NP28 = NP * 28
  446. NNT14 = NNT * 14
  447. NNT17 = NNT * 17
  448. C
  449. SEGINI MATRES
  450. C
  451. NUMP = 0
  452. C
  453. DO 20 INP = 1 , NP
  454. C
  455. IP1 = IPT1.NUM(1,INP)
  456. C
  457. C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
  458. C -------------------------------------
  459. IF (NUMP.EQ.0) THEN
  460. NUMP = NUMP + 1
  461. MATRES.NUMERO ( NUMP ) = IP1
  462. ELSE
  463. NON = 0
  464. DO 21 I = 1 , NUMP
  465. IF (MATRES.NUMERO(I).EQ.IP1) THEN
  466. NON = 1
  467. END IF
  468. 21 CONTINUE
  469. C
  470. IF (NON.EQ.0) THEN
  471. NUMP = NUMP + 1
  472. MATRES.NUMERO ( NUMP ) = IP1
  473. END IF
  474. END IF
  475. C
  476. IP2 = IPT1.NUM(2,INP)
  477. C
  478. C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
  479. C -------------------------------------
  480. NON = 0
  481. DO 22 I = 1 , NUMP
  482. IF (MATRES.NUMERO(I).EQ.IP2) THEN
  483. NON = 1
  484. END IF
  485. 22 CONTINUE
  486. C
  487. IF (NON.EQ.0) THEN
  488. NUMP = NUMP + 1
  489. MATRES.NUMERO ( NUMP ) = IP2
  490. END IF
  491. C
  492. C
  493. C -------------------- COOR : TABLEAU DES COORDONNEES
  494. C --------------------------------
  495. MATRES.COOR(1,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
  496. MATRES.COOR(2,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
  497. MATRES.COOR(3,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
  498. MATRES.COOR(1,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+1)
  499. MATRES.COOR(2,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+2)
  500. MATRES.COOR(3,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+3)
  501. C
  502. C -------------------- CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
  503. C --------------------------------------------
  504. C
  505. MATRES.CORRES(2*INP-1) = IP1
  506. MATRES.CORRES(2*INP ) = IP2
  507. C
  508. 20 CONTINUE
  509. C
  510. C
  511. C **********************************************************************
  512. C LECTURE DU CHPOINT (CONDITIONS AUX LIMITES)
  513. C **********************************************************************
  514. C
  515. C -------------------- XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
  516. C ---------- AUX LIMITES POUR CHAQUE NOEUD.
  517. C
  518. NSOUPO = MCHPO1.IPCHP(/1)
  519. C
  520. IMAS = 0
  521. IRAIDE = 0
  522. C
  523. DO 25 I = 1 , NNT
  524. DO 25 J = 1 , 17
  525. MATRES.XCL(J,I) = 0.E0
  526. MATRES.FLAG((I-1)*17+J) = 0
  527. 25 CONTINUE
  528. C
  529. DO 30 I = 1 , NSOUPO
  530. C
  531. MSOUP1 = MCHPO1.IPCHP(I)
  532. SEGACT MSOUP1
  533. C
  534. IPT2 = MSOUP1.IGEOC
  535. SEGACT IPT2
  536. C
  537. MPOVA2 = MSOUP1.IPOVAL
  538. SEGACT MPOVA2
  539. C
  540. NC = MSOUP1.NOCOMP(/2)
  541. N = MPOVA2.VPOCHA(/1)
  542. C
  543. DO 31 J = 1 , N
  544. C
  545. C -- ON CHERCHE NUM(1,J) CAR DANS UN CHAMP PAR POINTS, LES
  546. C -- ELEMENTS DES SOUS-MAILLAGES ELEMENTAIRES SONT LES POINTS
  547. C -- DE CES SOUS-MAILLAGES, ET CHAQUE ELEMENT CONTIENT DONC UN
  548. C -- SEUL NOEUD
  549. C
  550. NOEUD = IPT2.NUM(1,J)
  551. ISTOP = 0
  552. ISTO1 = 0
  553. C
  554. DO 33 K = 1 , NNT
  555. IF (MATRES.NUMERO(K).EQ.NOEUD) THEN
  556. NNOEUD = K
  557. END IF
  558. 33 CONTINUE
  559. C
  560. DO 32 K = 1 , NC
  561. COMP = MSOUP1.NOCOMP(K)
  562. CALL ELLA09(COMP,ICOMP,IERROR)
  563. IF (IERROR.NE.0) THEN
  564. RETURN
  565. END IF
  566. C
  567. C COMPTAGE DES MASSES
  568. C
  569. IF (ICOMP.GE.18.AND.ISTOP.EQ.0.AND.ICOMP.LE.21) THEN
  570. IMAS = IMAS + 1
  571. ISTOP = 1
  572. END IF
  573. C
  574. C COMPTAGE DES RAIDEURS
  575. C
  576. IF (ICOMP.GE.22.AND.ISTO1.EQ.0.AND.ICOMP.LE.27) THEN
  577. IRAIDE = IRAIDE + 1
  578. ISTO1 = 1
  579. ENDIF
  580. C
  581. C DETECTION DES MASSES ET AFFECTATION DES NUMEROS DE COLONNES
  582. C
  583. IF (ICOMP.EQ.18) THEN
  584. DO 35 II = 2*NP , 1 , -1
  585. IF (CORRES(II).EQ.NOEUD) THEN
  586. MATRES.MASS(1,IMAS) = II
  587. END IF
  588. 35 CONTINUE
  589. C
  590. MATRES.MASS(2,IMAS) = INT((MATRES.MASS(1,IMAS)+1)/2)
  591. II = MATRES.MASS(1,IMAS)
  592. JJ = INT(II/2)*2
  593. IF (II.EQ.JJ) THEN
  594. MATRES.MASS(3,IMAS) = 28*(MATRES.MASS(2,IMAS)-1)+15
  595. ELSE
  596. MATRES.MASS(3,IMAS) = 28*(MATRES.MASS(2,IMAS)-1)+1
  597. END IF
  598. C
  599. MATRES.RMAS(1,IMAS) = MPOVA2.VPOCHA(J,K)
  600. C
  601. ELSE IF (ICOMP.GT.18.AND.ICOMP.LE.21) THEN
  602. JMAS = ICOMP - 17
  603. MATRES.RMAS(JMAS,IMAS) = MPOVA2.VPOCHA(J,K)
  604. C
  605. ELSE IF (ICOMP.LT.18 ) THEN
  606. C
  607. MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
  608. MATRES.FLAG((NNOEUD-1)*17+ICOMP)=NNOEUD
  609. C
  610. END IF
  611. C
  612. C DETECTION DES RAIDEURS ET AFFECTATION DES NUMEROS DE COLONNES
  613. C
  614. IF (ICOMP.EQ.22) THEN
  615. C
  616. NUMFIC = 0
  617. DO 60 II = 2*NP , 1 , -1
  618. C
  619. IF (CORRES(II).EQ.NOEUD) THEN
  620. NUMFIC = NUMFIC + 1
  621. C
  622. IF (NUMFIC.GT.3) THEN
  623. STOP
  624. ENDIF
  625. C
  626. MATRES.IRAILO(NUMFIC,IRAIDE) = II
  627. END IF
  628. 60 CONTINUE
  629. C
  630. MATRES.IRAILO(4,IRAIDE)= NUMFIC
  631. C
  632. MATRES.VALRAI(1,IRAIDE) = MPOVA2.VPOCHA(J,K)
  633. C
  634. ELSE IF (ICOMP.GT.22.AND.ICOMP.LE.27) THEN
  635. JRAIDE = ICOMP - 21
  636. C
  637. MATRES.VALRAI(JRAIDE,IRAIDE) = MPOVA2.VPOCHA(J,K)
  638. C
  639. ELSE IF (ICOMP.LT.18) THEN
  640. C
  641. MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
  642. MATRES.FLAG((NNOEUD-1)*17+ICOMP)=NNOEUD
  643. C
  644. END IF
  645. C
  646. 32 CONTINUE
  647. 31 CONTINUE
  648. C
  649. C
  650. SEGDES IPT2
  651. SEGDES MPOVA2
  652. SEGDES MSOUP1
  653. C
  654. 30 CONTINUE
  655. C
  656. NMAS = IMAS
  657. NRAIDE = IRAIDE
  658. C
  659. C **********************************************************************
  660. C LECTURE DU NOUVEAU CHAMLEM (CARACTERISTIQUES DU MATERIAU
  661. C ET DU FLUIDE)
  662. C **********************************************************************
  663. C
  664. C
  665. NELEXP=0
  666. C
  667. C .................... CARACT : TABLEAU DES CARACTERISTIQUES
  668. C
  669. NN1 = MCHEL1.IMACHE(/1)
  670. C
  671. DO 700 I = 1 , NN1
  672. C
  673. IPT3 = MCHEL1.IMACHE(I)
  674. MCHAM1 = MCHEL1.ICHAML(I)
  675. C
  676. SEGACT IPT3
  677. NBE = IPT3.NUM(/2)
  678. C
  679. SEGACT MCHAM1
  680. NN2 = MCHAM1.IELVAL(/1)
  681. IF (NN2.EQ.1) THEN
  682. C
  683. C IL Y A UN SEUL MOT CLEF : C'EST VECT
  684. C ON A UN ELEMENT EXPERIMENTAL
  685. C
  686. CALL ELLA08(MCHAM1.NOMCHE(NN2),ICARAC,IERROR)
  687. IF (IERROR.NE.0) THEN
  688. RETURN
  689. END IF
  690. C
  691. IF (ICARAC.NE.11) THEN
  692. RETURN
  693. END IF
  694. C
  695. IF (NBE.GT.1) THEN
  696. RETURN
  697. END IF
  698. C
  699. MELVA1 = MCHAM1.IELVAL(NN2)
  700. SEGACT MELVA1
  701. IPP = MELVA1.IELCHE(1,1)
  702. X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
  703. X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
  704. X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
  705. SEGDES MELVA1
  706. C
  707. INU1 = IPT3.NUM(1,NBE)
  708. INU2 = IPT3.NUM(2,NBE)
  709. NCARAC = 0
  710. DO 720 III = 1 , NP2 , 2
  711. IN1 = MATRES.CORRES(III )
  712. IN2 = MATRES.CORRES(III+1)
  713. IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
  714. NCARAC = INT(III/2) + 1
  715. END IF
  716. IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
  717. NCARAC = INT(III/2) + 1
  718. END IF
  719. 720 CONTINUE
  720. C
  721. NELEXP=NELEXP+1
  722. MATRES.IEXPER(NCARAC)=1
  723. MATRES.GAMA(1,NCARAC) = X1
  724. MATRES.GAMA(2,NCARAC) = X2
  725. MATRES.GAMA(3,NCARAC) = X3
  726. C
  727. C********************************
  728. C
  729. ELSE
  730. C
  731. C ON LIT LES CARACTERISTIQUES D'UNE POUTRE FORMULATION
  732. C INTEGRALE
  733. C
  734. DO 713 II = 1,NN2
  735. C
  736. CALL ELLA08(MCHAM1.NOMCHE(II),ICARAC,IERROR)
  737. IF (IERROR.NE.0) THEN
  738. RETURN
  739. END IF
  740. C
  741. IF (ICARAC.NE.11) THEN
  742. MELVA1 = MCHAM1.IELVAL(II)
  743. SEGACT MELVA1
  744. XCARAC = MELVA1.VELCHE(1,1)
  745. SEGDES MELVA1
  746. ELSE
  747. MELVA1 = MCHAM1.IELVAL(II)
  748. SEGACT MELVA1
  749. IPP = MELVA1.IELCHE(1,1)
  750. X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
  751. X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
  752. X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
  753. SEGDES MELVA1
  754. END IF
  755. C
  756. DO 716 IE = 1 , NBE
  757. INU1 = IPT3.NUM(1,IE)
  758. INU2 = IPT3.NUM(2,IE)
  759. C
  760. NCARAC = 0
  761. C
  762. DO 717 III = 1 , NP2 , 2
  763. IN1 = MATRES.CORRES(III )
  764. IN2 = MATRES.CORRES(III+1)
  765. IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
  766. NCARAC = INT(III/2) + 1
  767. END IF
  768. C
  769. IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
  770. NCARAC = INT(III/2) + 1
  771. END IF
  772. C
  773. 717 CONTINUE
  774. C
  775. IF (ICARAC.NE.11) THEN
  776. MATRES.CARACT(ICARAC,NCARAC) = XCARAC
  777. ELSE
  778. MATRES.GAMA(1,NCARAC) = X1
  779. MATRES.GAMA(2,NCARAC) = X2
  780. MATRES.GAMA(3,NCARAC) = X3
  781. END IF
  782. C
  783. 716 CONTINUE
  784. C
  785. 713 CONTINUE
  786. C
  787. END IF
  788. C
  789. SEGDES MCHAM1
  790. SEGDES IPT3
  791. C
  792. 700 CONTINUE
  793. C
  794. C LECTURE DE LA TABLE DES ELEMENTS EXPERIMENTAUX
  795. C
  796. IF (NELEXP.GT.0) THEN
  797. CALL ELLA01(NELEXP,NP2,NFRQ,ITEXP,MATRES)
  798. END IF
  799. C
  800. C -------------------------- CALCUL DE LA VALEUR REEL DE NPOI
  801. C --------------------------------
  802. DO 50 I = 1 , NNT
  803. IF (MATRES.NUMERO(I).EQ.NPOI) THEN
  804. NNPOI = I
  805. END IF
  806. 50 CONTINUE
  807. C
  808. SEGDES IPT1
  809. SEGDES MCHPO1
  810. SEGDES MCHEL1
  811. C
  812. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  813. C
  814. IF (IMP.NE.0) THEN
  815. C
  816. C ----------------------------------------------------------------------
  817. C
  818. C IMPRESSION DES TABLEAUX CREES A L'INTERFACE
  819. C
  820. C - COOR ( 3 , 2*NP )
  821. C - CORRES ( 2*NP )
  822. C - GAMA ( 3 , NP )
  823. C - CARACT (10 , NP )
  824. C - XCL (17 , NNT )
  825. C - FLAG ( 17*NNT )
  826. C - NUMERO ( NNT )
  827. C - MASS ( 3 , NMAS )
  828. C - RMAS ( 4 , NMAS )
  829. C - IRAILO ( 4 , NRAIDE )
  830. C - VALRAI ( 6 , NRAIDE )
  831. C
  832. C ----------------------------------------------------------------------
  833. C
  834. WRITE (IMP,*) 'TABLEAU COOR :'
  835. WRITE (IMP,*) '************'
  836. C
  837. DO 980 I = 1 , 2*NP
  838. WRITE (IMP,*) 'NOEUD ',I,':',
  839. * MATRES.COOR(1,I),MATRES.COOR(2,I),MATRES.COOR(3,I)
  840. 980 CONTINUE
  841. C
  842. WRITE (IMP,*) 'TABLEAU CORRES :'
  843. WRITE (IMP,*) '**************'
  844. C
  845. DO 981 I = 1 , 2*NP
  846. WRITE (IMP,*) 'NOEUD ',I,':',MATRES.CORRES(I)
  847. 981 CONTINUE
  848. C
  849. C
  850. WRITE (IMP,*) 'TABLEAU NUMERO :'
  851. WRITE (IMP,*) '**************'
  852. C
  853. DO 987 I = 1 , NNT
  854. WRITE (IMP,*) 'NOEUD ',I,':',MATRES.NUMERO(I)
  855. 987 CONTINUE
  856. C
  857. WRITE (IMP,*) 'TABLEAU GAMA :'
  858. WRITE (IMP,*) '************'
  859. C
  860. DO 982 I = 1 , NP
  861. WRITE (IMP,*) 'POUTRE ',I,':',
  862. * MATRES.GAMA(1,I),MATRES.GAMA(2,I),MATRES.GAMA(3,I)
  863. 982 CONTINUE
  864. C
  865. WRITE (IMP,*) 'TABLEAU CARACT :'
  866. WRITE (IMP,*) '**************'
  867. C
  868. DO 983 I = 1 , NP
  869. WRITE (IMP,*) 'E : ',MATRES.CARACT ( 1 , I)
  870. WRITE (IMP,*) 'NU : ',MATRES.CARACT ( 2 , I)
  871. WRITE (IMP,*) 'RHO : ',MATRES.CARACT ( 3 , I)
  872. WRITE (IMP,*) 'RINT : ',MATRES.CARACT ( 4 , I)
  873. WRITE (IMP,*) 'REXT : ',MATRES.CARACT ( 5 , I)
  874. WRITE (IMP,*) 'KCYZ : ',MATRES.CARACT ( 6 , I)
  875. WRITE (IMP,*) 'CAM : ',MATRES.CARACT ( 7 , I)
  876. WRITE (IMP,*) 'ETA : ',MATRES.CARACT ( 8 , I)
  877. WRITE (IMP,*) 'RHOF : ',MATRES.CARACT ( 9 , I)
  878. WRITE (IMP,*) 'CSON : ',MATRES.CARACT (10 , I)
  879. 983 CONTINUE
  880. C
  881. WRITE (IMP,*) 'TABLEAU XCL :'
  882. WRITE (IMP,*) '***********'
  883. C
  884. DO 984 I = 1 , 17
  885. DO 985 J = 1 , NNT
  886. WRITE (IMP,*) I , J,':',MATRES.XCL (I,J)
  887. 985 CONTINUE
  888. 984 CONTINUE
  889. C
  890. WRITE (IMP,*) 'TABLEAU FLAG :'
  891. WRITE (IMP,*) '************'
  892. C
  893. DO 986 I = 1 , 17*NNT
  894. WRITE (IMP,*) 'VAL ',I,':',MATRES.FLAG ( I )
  895. 986 CONTINUE
  896. C
  897. WRITE(IMP,*) 'TABLEAU POUR LES MASSES :'
  898. WRITE(IMP,*) '***********************'
  899. C
  900. WRITE(IMP,*)'NMAS : ',NMAS
  901. C
  902. IF (NMAS.GT.0) THEN
  903. C
  904. DO 988 I = 1 , NMAS
  905. WRITE (IMP,*) 'MASS (1,',I,') :',MATRES.MASS(1,I)
  906. WRITE (IMP,*) 'MASS (2,',I,') :',MATRES.MASS(2,I)
  907. WRITE (IMP,*) 'MASS (3,',I,') :',MATRES.MASS(3,I)
  908. WRITE (IMP,*) 'MASS (4,',I,') :',MATRES.MASS(4,I)
  909. 988 CONTINUE
  910. C
  911. DO 989 I = 1 , NMAS
  912. WRITE (IMP,*) 'RMAS (1,',I,') :',MATRES.RMAS(1,I)
  913. WRITE (IMP,*) 'RMAS (2,',I,') :',MATRES.RMAS(2,I)
  914. WRITE (IMP,*) 'RMAS (3,',I,') :',MATRES.RMAS(3,I)
  915. WRITE (IMP,*) 'RMAS (4,',I,') :',MATRES.RMAS(4,I)
  916. 989 CONTINUE
  917. END IF
  918. C
  919. WRITE(IMP,*) 'TABLEAU POUR LES RAIDEURS :'
  920. WRITE(IMP,*) '*************************'
  921. C
  922. WRITE(IMP,*) 'NRAIDE : ',NRAIDE
  923. C
  924. IF (NRAIDE.GT.0) THEN
  925. DO 800 I = 1 , NRAIDE
  926. WRITE(IMP,*) 'IRAILO(1,',I,') :',MATRES.IRAILO(1,I)
  927. WRITE(IMP,*) 'IRAILO(2,',I,') :',MATRES.IRAILO(2,I)
  928. WRITE(IMP,*) 'IRAILO(3,',I,') :',MATRES.IRAILO(3,I)
  929. WRITE(IMP,*) 'IRAILO(4,',I,') :',MATRES.IRAILO(4,I)
  930. C
  931. 800 CONTINUE
  932. C
  933. DO 810 I = 1 , NRAIDE
  934. WRITE(IMP,*) 'VALRAI(1,',I,') :',MATRES.VALRAI(1,I)
  935. WRITE(IMP,*) 'VALRAI(2,',I,') :',MATRES.VALRAI(2,I)
  936. WRITE(IMP,*) 'VALRAI(3,',I,') :',MATRES.VALRAI(3,I)
  937. WRITE(IMP,*) 'VALRAI(4,',I,') :',MATRES.VALRAI(4,I)
  938. WRITE(IMP,*) 'VALRAI(5,',I,') :',MATRES.VALRAI(5,I)
  939. WRITE(IMP,*) 'VALRAI(6,',I,') :',MATRES.VALRAI(6,I)
  940. C
  941. 810 CONTINUE
  942. END IF
  943. C
  944. C DO 820 I=1,NFRQ
  945. C WRITE(IMP,*) 'MLREE1.PROG(',I,')= ',MLREE1.PROG(I)
  946. C 820 CONTINUE
  947. C
  948. C
  949. WRITE(IMP,*) 'NOMBRE D''ELEMENTS EXPERIMENTAUX NELEXP ',NELEXP
  950. DO 830 I=1,NP
  951. WRITE(IMP,*) 'IEXPER(',I,')= ',MATRES.IEXPER(I)
  952. 830 CONTINUE
  953. C
  954. DO 870 K=1,NP
  955. C
  956. IF (MATRES.IEXPER(K).NE.0) THEN
  957. DO 840 L=1,NFRQ
  958. DO 850 I=1,14
  959. DO 860 J=1,28
  960. C WRITE(IMP,*) MATRES.ALPHAI(I,J,K,L)
  961. IF (ABS(ALPHAI(I,J,K,L)).GE.1.0D-10) THEN
  962. WRITE(IMP,871) I,J,K,L,MATRES.ALPHAI(I,J,K,L)
  963. 871 FORMAT(1X,'ALPHAI(',I2,',',I2,',',I2,',',I2,')= ',2(1X,E12.5))
  964. END IF
  965. 860 CONTINUE
  966. 850 CONTINUE
  967. 840 CONTINUE
  968. C
  969. END IF
  970. 870 CONTINUE
  971. C
  972. END IF
  973. C
  974. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  975. C
  976. C ----------------------------------------------------------------------
  977. C
  978. C APPEL DU PROGRAMME FORTRAN POUR LA RESOLUTION DU PROBLEME
  979. C
  980. C TABLEAUX D'ENTREE :
  981. C
  982. C COOR(3,2*NP), CORRES(2*NP), GAMA(3,NP), CARACT(10,NP),
  983. C XCL(17,NNT) , FLAG (17*NNT), NUMERO (NNT) (NP NOMBRE DE POUTRES
  984. C NNT NOMBRE REEL DE NOEUDS)
  985. C IRAILO(4,NNT), VALRAI(6,NNT)
  986. C
  987. C TABLEAUX DE SORTIE :
  988. C
  989. C ZA1(28*NP,28*NP) , ZSM (28*NP) , ZXX (28*NP)
  990. C
  991. C ----------------------------------------------------------------------
  992. C
  993. DO 141 I = 1 , NFRQ
  994. DO 142 J = 1 , NNT14
  995. MATRES.ZSOL(J,I) = CMPLX(0.D0,0.D0)
  996. 142 CONTINUE
  997. 141 CONTINUE
  998. C
  999. CALL ELLA11(MATRES.COOR , MATRES.CORRES , MATRES.GAMA ,
  1000. * MATRES.CARACT , MATRES.XCL , MATRES.FLAG ,
  1001. * MATRES.NUMERO , MATRES.ZA1 , MATRES.ZSM ,
  1002. * MATRES.ZXX , MATRES.ZSOL , MATRES.MASS ,
  1003. * MATRES.RMAS , NMAS , MATRES.IPIVO ,
  1004. * MATRES.JPIVO , MATRES.IAUX , MLREE1.PROG ,
  1005. & MATRES.IRAILO , MATRES.VALRAI , NRAIDE ,
  1006. & MATRES.IEXPER , MATRES.ALPHAI ,NELEXP, NP , NP28 ,
  1007. & NNT , NNT14 , NFRQ ,
  1008. & S0 , XPI , METH , IMP)
  1009. C
  1010. ZS = S0 + (0.D0 , 1.D0 ) * 2. * XPI * MLREE1.PROG(1)
  1011. C
  1012. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  1013. IF (IMP.NE.0) THEN
  1014. WRITE (IMP,*)'VECTEUR SOLUTION ZSOL : ( PREMIERE FREQUENCE ) '
  1015. DO 42 J = 1 , NNT14
  1016. WRITE (IMP,*) J,MATRES.ZSOL(J,1)
  1017. 42 CONTINUE
  1018. C
  1019. END IF
  1020. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  1021. C
  1022. IF (IDEPL.EQ.0) THEN
  1023. C
  1024. JG = NFRQ
  1025. SEGINI MLREE2
  1026. SEGINI MLREE3
  1027. C
  1028. DO 100 I = 1 , NFRQ
  1029. C
  1030. MLREE2.PROG(I) = ABS(MATRES.ZSOL((NNPOI-1)*14+ICHAR,I))
  1031. C
  1032. ZT = MATRES.ZSOL((NNPOI-1)*14+ICHAR,I)
  1033. PRZT = ZT
  1034. PIZT = ZT*(0.D0,-1.D0)
  1035. C
  1036. IF (ABS(PRZT).LT.XPETIT.AND.ABS(PIZT).LT.XPETIT) THEN
  1037. MLREE3.PROG(I) = 0.D0
  1038. ELSE
  1039. MLREE3.PROG(I) = ATAN2(PIZT,PRZT)*180.D0/XPI
  1040. END IF
  1041. C
  1042. 100 CONTINUE
  1043. C
  1044. C ------------------- OUVERTURE DU SEGMENT RESULTAT TYPE EVOLUTION
  1045. C --------------------------------------------
  1046. C
  1047. N = 2
  1048. SEGINI MEVOL1
  1049. SEGINI KEVOL1
  1050. SEGINI KEVOL2
  1051. C
  1052. MEVOL1.ITYEVO = 'COMPLEXE'
  1053. C MEVOL1.IEVTEX = 'OPERATEUR ELFE LAPLACE POUTRE'
  1054. MEVOL1.IEVOLL(1) = KEVOL1
  1055. MEVOL1.IEVOLL(2) = KEVOL2
  1056. C
  1057. C
  1058. KEVOL1.IPROGX = MLREE1
  1059. KEVOL1.IPROGY = MLREE2
  1060. KEVOL1.NUMEVY = 'MODU'
  1061. KEVOL1.TYPX = 'LISTREEL'
  1062. KEVOL1.TYPY = 'LISTREEL'
  1063. KEVOL1.NOMEVX = 'FREQ (HZ)'
  1064. KEVOL1.NOMEVY = CHAR
  1065. C KEVOL1.KEVTEX = '********'
  1066. C
  1067. C
  1068. KEVOL2.IPROGX = MLREE1
  1069. KEVOL2.IPROGY = MLREE3
  1070. KEVOL2.NUMEVY = 'PHAS'
  1071. KEVOL2.TYPX = 'LISTREEL'
  1072. KEVOL2.TYPY = 'LISTREEL'
  1073. KEVOL2.NOMEVX = 'FREQ (HZ)'
  1074. KEVOL2.NOMEVY = CHAR
  1075. C KEVOL2.KEVTEX = '********'
  1076. C
  1077. C
  1078. CALL ECROBJ('EVOLUTION',MEVOL1)
  1079. C
  1080. SEGDES KEVOL1
  1081. SEGDES KEVOL2
  1082. SEGDES MEVOL1
  1083. SEGDES MLREE2
  1084. SEGDES MLREE3
  1085. C
  1086. ELSE
  1087. C
  1088. DO 230 I = 1 , 2
  1089. DO 240 J = 1 , NBELEM
  1090. IP1 = IPT4.NUM(I,J)
  1091. MATRES.XCOR(I,1,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
  1092. MATRES.XCOR(I,2,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
  1093. MATRES.XCOR(I,3,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
  1094. 240 CONTINUE
  1095. 230 CONTINUE
  1096. C
  1097. CALL ELLA23(MATRES.CARACT , MATRES.COOR , MATRES.GAMA ,
  1098. * MATRES.ZXX , MATRES.XCOR , MATRES.VALDE1,
  1099. * MATRES.VALDE2 , MATRES.VALDE3 , MATRES.VALDE4 ,
  1100. * ZS , NP , NBELEM , XPI )
  1101. C
  1102. N1 = 1
  1103. N2 = 8
  1104. L1= 0
  1105. N3= 0
  1106. SEGINI MCHEL1
  1107. SEGINI MCHAM1
  1108. MCHEL1.IMACHE(1) = IPT4
  1109. MCHEL1.ICHAML(1) = MCHAM1
  1110. C
  1111. MCHAM1.NOMCHE(1) = 'UXM'
  1112. MCHAM1.NOMCHE(2) = 'UYM'
  1113. MCHAM1.NOMCHE(3) = 'UZM'
  1114. MCHAM1.NOMCHE(4) = 'UXP'
  1115. MCHAM1.NOMCHE(5) = 'UYP'
  1116. MCHAM1.NOMCHE(6) = 'UZP'
  1117. MCHAM1.NOMCHE(7) = 'PM'
  1118. MCHAM1.NOMCHE(8) = 'PP'
  1119. MCHAM1.TYPCHE(1) = 'REAL*8'
  1120. MCHAM1.TYPCHE(2) = 'REAL*8'
  1121. MCHAM1.TYPCHE(3) = 'REAL*8'
  1122. MCHAM1.TYPCHE(4) = 'REAL*8'
  1123. MCHAM1.TYPCHE(5) = 'REAL*8'
  1124. MCHAM1.TYPCHE(6) = 'REAL*8'
  1125. MCHAM1.TYPCHE(7) = 'REAL*8'
  1126. MCHAM1.TYPCHE(8) = 'REAL*8'
  1127. C
  1128. N1PTEL = 2
  1129. N1EL = NBELEM
  1130. N2PTEL = 0
  1131. N2EL = 0
  1132. C
  1133. SEGINI MELVA1
  1134. SEGINI MELVA2
  1135. SEGINI MELVA3
  1136. SEGINI MELVA4
  1137. SEGINI MELVA5
  1138. SEGINI MELVA6
  1139. C
  1140. MCHAM1.IELVAL(1) = MELVA1
  1141. MCHAM1.IELVAL(2) = MELVA2
  1142. MCHAM1.IELVAL(3) = MELVA3
  1143. MCHAM1.IELVAL(4) = MELVA4
  1144. MCHAM1.IELVAL(5) = MELVA5
  1145. MCHAM1.IELVAL(6) = MELVA6
  1146. C
  1147. DO 200 I = 1 , 2
  1148. DO 210 J = 1 , NBELEM
  1149. MELVA1.VELCHE(I,J) = VALDE1 ( I , J , 1 )
  1150. MELVA2.VELCHE(I,J) = VALDE1 ( I , J , 2 )
  1151. MELVA3.VELCHE(I,J) = VALDE1 ( I , J , 3 )
  1152. MELVA4.VELCHE(I,J) = VALDE2 ( I , J , 1 )
  1153. MELVA5.VELCHE(I,J) = VALDE2 ( I , J , 2 )
  1154. MELVA6.VELCHE(I,J) = VALDE2 ( I , J , 3 )
  1155. 210 CONTINUE
  1156. 200 CONTINUE
  1157. C
  1158. C MCHAM1.IELVAL(7) = MELVA1
  1159. C MCHAM1.IELVAL(8) = MELVA2
  1160. C
  1161. C DO 300 I = 1 , 2
  1162. C DO 310 J = 1 , NBELEM
  1163. C MELVA1.VELCHE(I,J) = VALDE3 ( I , J , 1 )
  1164. C MELVA2.VELCHE(I,J) = VALDE4 ( I , J , 1 )
  1165. C310 CONTINUE
  1166. C300 CONTINUE
  1167. C
  1168. * NSOUPO = 1
  1169. * NAT=1
  1170. * SEGINI MCHPO1
  1171. CALL CHAMPO(MCHEL1,1,MCHPO1,IRET)
  1172. CALL ECROBJ('CHPOINT',MCHPO1)
  1173. C
  1174. SEGDES MELVA1
  1175. SEGDES MELVA2
  1176. SEGDES MELVA3
  1177. SEGDES MELVA4
  1178. SEGDES MELVA5
  1179. SEGDES MELVA6
  1180. SEGDES MCHAM1
  1181. SEGDES MCHEL1
  1182. SEGDES MCHPO1
  1183. C
  1184. C
  1185. END IF
  1186. C
  1187. SEGDES MLREE1
  1188. SEGSUP MATRES
  1189. C
  1190. END
  1191.  
  1192.  
  1193.  
  1194.  
  1195.  
  1196.  
  1197.  
  1198.  
  1199.  
  1200.  

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