Télécharger ellp00.eso

Retour à la liste

Numérotation des lignes :

  1. C ELLP00 SOURCE PV 11/03/07 21:16:46 6885
  2. SUBROUTINE ELLP00
  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
  10. C OPERATEUR ELFE LAPLACE POUTRE
  11. C
  12. C CALCUL DES FONCTIONS DE TRANSFERT D'UN MAILLAGE DE POUTRES PAR
  13. C LA METHODE DITE "INTEGRALE". LA SYNTAXE EST LA SUIVANTE :
  14. C
  15. C EVOL = ELFE LAPLACE POUTRE GEO1 (GEO2) CHP1 CHAM1 LFR S0 PT
  16. C COMP IMETH (IMP)
  17. C
  18. C
  19. C ELFE .............. MOT DESIGNANT L'OPERATEUR
  20. C
  21. C LAPLACE, POUTRE ... MOTS CLES POUR L'OPTION DE ELFE
  22. C
  23. C GEO1 .............. OBJET TYPE MAILLAGE DONNANT LE RESEAU DE POUTRES
  24. C
  25. C GEO2 (FACULTATIF).. OBJET TYPE MAILLAGE SI ON VEUT LA DEFORMEE
  26. C
  27. C CHP1 .............. OBJET TYPE CHPOINT DONNANT LES COND. AUX LIMITE
  28. C
  29. C CHAM1 ............. OBJET TYPE NOUVEAU CHAMELEM POUR LES CARACT.
  30. C
  31. C LFR ............... OBJET TYPE LISTREEL DEFINISSANT LES FREQUENCES
  32. C
  33. C S0 ............... OBJET TYPE REEL POUR LA TRANSFORMEE DE LAPLACE
  34. C
  35. C PT ................ OBJET TYPE POINT OU L'ON DESIRE LE DEPLACEMENT
  36. C
  37. C COMP .............. OBJET TYPE CHAR*2 DESIGNANT 'UX','UY' OU 'UZ'
  38. C 'RX','RY' OU 'RZ'
  39. C
  40. C IMETH ............. ENTIER : CHOIX DE LA METHODE DE RESOLUTION
  41. C
  42. C IMP (FALCULTATIF).. ENTIER : <>0 POUR IMPRESSION INTERMEDIAIRE
  43. C
  44. C
  45. C PARAMETRES :
  46. C ('NEANT')
  47. C
  48. C SORTIES :
  49. C
  50. C EVOLUTION --------> SI ON DESIRE LA FONCTION DE TRANSFERT
  51. C
  52. C CHAMPOINT --------> SI ON DESIRE LA DEFORMEE
  53. C
  54. C
  55. C *****************************************************
  56. C * *
  57. C * Organigramme d'appel des diff{rentes SUBROUTINE *
  58. C * *
  59. C *****************************************************
  60. C
  61. C
  62. C ELLP00 (interface ESOPE <--> FORTRAN)
  63. C |
  64. C |
  65. C |-----> ELLP09 (conversion de ux , uy ... en 1 , 2 , ...)
  66. C |
  67. C |-----> ELLP08 (conversion de YOUN , NU ... en 1 , 2 , ...)
  68. C |
  69. C |
  70. C |-----> ELLP11 (programme principal FORTRAN)
  71. C |
  72. C |
  73. C |-----> ELLP12 (remplissage de la 2}me partie de ZA1
  74. C | qui ne d{pend pas de w)
  75. C |
  76. C |-----> ELLP21 (determination, pour chaque poutre et
  77. C | chaque frequence, de la matrice ZC1)
  78. C |
  79. C |
  80. C |-----> ELLP31 (valeur des fcts de GREEN)
  81. C |
  82. C |<--------|
  83. C |
  84. C |
  85. C |-----> ELLP51 (resolution du systeme lin{aire)
  86. C | (ELLP52)
  87. C | (ELLP53)
  88. C | (ELLP54)
  89. C |
  90. C |
  91. C |<--------|
  92. C |
  93. C |-----> ELLP23 (d{termination des d{placements aux noeuds du
  94. C | sous-maillage dans le cas du calcul de la
  95. C | d{form{e )
  96. C |
  97. C | -------------
  98. C | | |
  99. C |--------------->| FIN |
  100. C | |
  101. C -------------
  102. C
  103. C AUTEUR : SAINT-DIZIER
  104. C DATE : 04 JANVIER 1990 (VERSION DU 22 AOUT 1990)
  105. C
  106. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  107. C
  108. CHARACTER*4 COMP,CHAR
  109. C
  110. C
  111. -INC CCREEL
  112. -INC CCOPTIO
  113. -INC SMCOORD
  114. -INC SMELEME
  115. -INC SMCHPOI
  116. -INC SMCHAML
  117. -INC SMLREEL
  118. -INC SMEVOLL
  119. C
  120. POINTEUR MLREE4.MLREEL
  121. POINTEUR KEVOL3.KEVOLL
  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 (NP24,NP24)
  128. COMPLEX*16 ZSM (NP24)
  129. COMPLEX*16 ZXX (NP24)
  130. COMPLEX*16 ZSOL (NNT12,NFRQ)
  131. REAL*8 COOR (3 ,NP2)
  132. REAL*8 GAMA (3 ,NP)
  133. REAL*8 CARACT(12,NP)
  134. REAL*8 XCL (12 ,NNT)
  135. REAL*8 XCOR (2 , 3 , NBELEM )
  136. REAL*8 VALDE1(2 , NBELEM , 3 )
  137. REAL*8 VALDE2(2 , NBELEM , 3 )
  138. INTEGER FLAG (NNT12)
  139. INTEGER CORRES(NP2)
  140. INTEGER NUMERO(NNT)
  141. INTEGER MASS (NNT,4)
  142. REAL*8 RMAS (NNT,4)
  143. INTEGER IPIVO(NP24)
  144. INTEGER JPIVO(NP24)
  145. INTEGER IAUX(NP24)
  146. ENDSEGMENT
  147. C
  148. SEGMENT MATITE
  149. REAL*8 SA(NP48,NP48)
  150. REAL*8 SB(NP48)
  151. REAL*8 SU(NP48)
  152. REAL*8 SR(NP48)
  153. REAL*8 SQ(NP48)
  154. REAL*8 SDELTA(NP48)
  155. REAL*8 SDELT1(NP48)
  156. REAL*8 SP(NP48)
  157. REAL*8 SP1(NP48)
  158. REAL*8 SCH(NP48)
  159. REAL*8 SCH1(NP48)
  160. INTEGER IIVO(NP48)
  161. INTEGER JIVO(NP48)
  162. INTEGER IIUX(NP48)
  163. INTEGER ITERA (NFRQ)
  164. ENDSEGMENT
  165. C
  166. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  167. C
  168. C EXPLICATION DE CES VARIABLES
  169. C ----------------------------
  170. C
  171. C NP : NOMBRE TOTAL DE POUTRES DU MAILLAGE
  172. C
  173. C NP2 : NP * 2
  174. C
  175. C NP24 : NP * 24
  176. C
  177. C NP48 : NP * 48
  178. C
  179. C NNT : NOMBRE TOTAL DE NOEUDS DU MAILLAGE
  180. C
  181. C NNT12 : NNT * 12
  182. C
  183. C NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
  184. C
  185. C ---------------------------------------------------------------------
  186. C
  187. C .................... ZA1 : MATRICE DE RESOLUTION
  188. C
  189. C .................... ZSM : VECTEUR SECOND MEMBRE
  190. C
  191. C .................... ZXX : VECTEUR INCONNU
  192. C
  193. C ZXX CONTIENT, POUR LES 2NP NOEUDS, DANS L'ORDRE SUIVANT :
  194. C
  195. C UX UY UZ RX RY RZ FX FY FZ MX MY MZ
  196. C
  197. C
  198. C .................... ZSOL : TABLEAU SOLUTION POUR TOUTES LES FREQ.
  199. C
  200. C
  201. C .................... COOR : TABLEAU DES COORDONNEES
  202. C
  203. C UNE POUTRE COMPORTE 2 NOEUDS (P1 ET P2) --> 2*NP NOEUDS FICTIFS
  204. C
  205. C | COOR(1,2*INP-1) | COOR(1,2*INP)
  206. C P1 | COOR(2,2*INP-1) P2 | COOR(2,2*INP)
  207. C | COOR(3,2*INP-1) | COOR(3,2*INP)
  208. C
  209. C ---------------------------------------------------------------------
  210. C
  211. C .................... GAMA : VECTEUR DEFINISSANT L'AXE OY
  212. C POUR CHAQUE POUTRE
  213. C
  214. C
  215. C .................... CARACT : TABLEAU DES CARACTERISTIQUES
  216. C
  217. C CARACT EST UNE MATRICE (12,NP) QUI, POUR TOUTES LES NP POUTRES,
  218. C DONNE LES CARACTERISTIQUES GEOMETRIQUES ET PHYSIQUE DE LA POUTRE :
  219. C
  220. C CARACT( 1,INP) --> MODULE D'YOUNG : E
  221. C CARACT( 2,INP) --> COEFICIENT DE POISSON : NU
  222. C CARACT( 3,INP) --> MASSE VOLUMIQUE : RHO
  223. C CARACT( 4,INP) --> SECTION DROITE DE LA POUTRE : SE
  224. C CARACT( 5,INP) --> MOMENT DE TORSION : C
  225. C CARACT( 6,INP) --> MOMENT D'INERTIE POLAIRE : IP
  226. C CARACT( 7,INP) --> MOMENT D'INERTIE SUIVANT L'AXE OY : IY
  227. C CARACT( 8,INP) --> MOMENT D'INERTIE SUIVANT L'AXE OZ : IZ
  228. C CARACT( 9,INP) --> CONSTANTE DE TIMOSHENKO KCY : KCY
  229. C CARACT(10,INP) --> CONSTANTE DE TIMOSHENKO KCZ : KCZ
  230. C CARACT(11,INP) --> COEFICIENT D'AMORTISSEMENT EXTERNE : CAM
  231. C CARACT(12,INP) --> COEFICIENT D'AMORTISSEMENT INTERNE : ETA
  232. C
  233. C ---------------------------------------------------------------------
  234. C
  235. C .................... XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
  236. C AUX LIMITES POUR CHAQUE NOEUD.
  237. C
  238. C XCL (K,NN) = VALEUR DE LA CONDITION K AU NOEUD REEL NN
  239. C LES CONDITIONS K CORRESPONDENT RESPECTIVEMENT A UX, UY, UZ, RX,
  240. C RY, RZ, FX, FY, FZ, MX, MY, MZ.
  241. C
  242. C CHAQUE NOEUD AYANT SOIT LES DEPLACEMENTS, SOIT LES EFFORTS, SOIT
  243. C RIEN DU TOUT D'IMPOSES, IL CONVIENT DE DEFINIR UN VECTEUR JOUANT LE
  244. C ROLE DE POINTEUR SUR XCL QUE L'ON APPELLE FLAG DE LONGUEUR 12*NNT.
  245. C
  246. C LES DIFFERENTS BLOCS DE 12 VALEURS POINTENT SUR LE NOEUD CORRES-
  247. C PONDANT :
  248. C
  249. C LA VALEUR DE FLAG VAUT LE NUMERO DU NOEUD SI ON IMPOSE LA CONDITION
  250. C ELLE VAUT 0 SINON.
  251. C
  252. C ---------------------------------------------------------------------
  253. C
  254. C .................... CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
  255. C
  256. C CHAQUE NOEUD FICTIF EST ASSOCIE A UN NOEUD REEL ; LE TABLEAU CORRES
  257. C DONNE, POUR CHAQUE NOEUD FICTIF (2*NP), LE NUMERO DU NOEUD REEL AS-
  258. C SOCIE.
  259. C
  260. C ---------------------------------------------------------------------
  261. C
  262. C
  263. C .................... NUMERO : TABLEAU DE NUMERO DE NOEUDS
  264. C
  265. C NUMERO (I) = NUMERO GIBI DU IEME NOEUD ( 1 < I < N )
  266. C
  267. C LA NUMEROTATION DE 1 A N EST ARBITRAIREMENT SELON LES NUMEROS
  268. C CROISSANTS DANS GIBI.
  269. C
  270. C
  271. C .................... MASS : TABLEAU DONNANT POUR CHAQUE MASSE
  272. C PONCTUELLE :
  273. C
  274. C - MASS(NNT,1) ... NUMERO DU NOEUD OU S'APPLIQUE LA MASSE
  275. C - MASS(NNT,2) ... NUMERO DE LA POUTRE ASSOCIEE
  276. C - MASS(NNT,3) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
  277. C DANS LE VECTEUR DES INCONNUS
  278. C - MASS(NNT,4) ... NUMERO DE LA LIGNE TRADUISANT
  279. C SOMME FX = FX EXTERIEURES
  280. C
  281. C .................... RMAS : TABLEAU DONNANT POUR LE NOEUD
  282. C CORRESPONDANT LA VALEUR DE LA MASSE
  283. C DE J0X
  284. C DE J0Y
  285. C DE J0Z
  286. C
  287. C ........... IPIVO,JPIVO,IAUX : TABLEAU INTERMEDIAIRE DE MEMORISATION
  288. C DE LA TRIANGULARISATION DE GAUSS
  289. C
  290. C
  291. C ..................... VALDE1 : TABLEAU DONNANT POUR CHAQUE ELEMENT
  292. C DU SOUS MAILLAGE LE MODULE DU DEPLA-
  293. C CEMENT
  294. C
  295. C ..................... VALDE2 : TABLEAU DONNANT POUR CHAQUE ELEMENT
  296. C DU SOUS MAILLAGE LA PHASE DU DEPLA-
  297. C CEMENT
  298. C
  299. C
  300. C ......S E G M E N T MATITE : TABLEAUX NE SERVANT QUE POUR
  301. C L'EVENTUALITE D'UNE METHODE ITERATIVE
  302. C
  303. C
  304. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  305. C
  306. C ------------------- DIMENSIONNEMENT DES MATRICES AUXILIAIRES
  307. C ----------------------------------------
  308. C
  309. SEGMENT AUXI
  310. INTEGER IAUXI(NNNP)
  311. ENDSEGMENT
  312. C
  313. C -------------------- LECTURE DES OBJETS MAILLAGE CHPOINT ET LISTREEL
  314. C -----------------------------------------------
  315. C
  316. C
  317. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  318. IF (IERR.NE.0) RETURN
  319. C
  320. CALL LIROBJ('MAILLAGE',IPT4,0,IRETOU)
  321. IF (IERR.NE.0) RETURN
  322. IF (IRETOU.NE.0) THEN
  323. IDEPL = 1
  324. SEGACT IPT4
  325. NBELEM = IPT4.NUM(/2)
  326. ELSE
  327. IDEPL = 0
  328. NBELEM = 1
  329. END IF
  330. C
  331. CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
  332. IF (IERR.NE.0) RETURN
  333. C
  334. CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
  335. IF (IERR.NE.0) RETURN
  336. C
  337. CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
  338. IF (IERR.NE.0) RETURN
  339. C
  340. CALL LIRREE(S0,1,IRETOU)
  341. IF (IERR.NE.0) RETURN
  342. C
  343. CALL LIROBJ('POINT',NPOI,1,IRETOU)
  344. IF (IERR.NE.0) RETURN
  345. C
  346. CALL LIRCHA(CHAR,1,LCHAR)
  347. IF (IERR.NE.0) RETURN
  348. C
  349. CALL ELLP09(CHAR,ICHAR,IERROR)
  350. C
  351. IF (IERROR.NE.0.OR.ICHAR.GT.12) THEN
  352. WRITE(IOIMP,*)'ERREUR DANS LA LECTURE DES DONNEES *********'
  353. WRITE(IOIMP,*)'ON NE RECONNAIT PAS UX, UY, UZ, RX, RY OU RZ'
  354. WRITE(IOIMP,*)'DANS LA DEMANDE DES RESULTATS. '
  355. RETURN
  356. END IF
  357. C
  358. CALL LIRENT(METH,1,IRETOU)
  359. IF (IERR.NE.0) RETURN
  360. C
  361. CALL LIRENT(IMP,0,IRETOU)
  362. IF (IERR.NE.0) RETURN
  363. IF (IRETOU.EQ.0) IMP = 0
  364. IF (IMP.NE.0) IMP = IOIMP
  365. C
  366. C
  367. C -------------------- ACTIVATION DES SEGMENTS
  368. C -----------------------
  369. SEGACT IPT1
  370. SEGACT MLREE1
  371. SEGACT MCHPO1
  372. SEGACT MCHEL1
  373. C
  374. C
  375. C **********************************************************************
  376. C LECTURE DU MAILLAGE
  377. C **********************************************************************
  378. C
  379. C ..................NP : NOMBRE DE POUTRES DU MAILLAGE
  380. C
  381. NP = IPT1.NUM(/2)
  382. C
  383. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  384. C
  385. IF (IMP.NE.0) THEN
  386. WRITE (IMP,*) 'NOMBRE DE POUTRES DU MAILLAGE :',NP
  387. END IF
  388. C
  389. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  390. C
  391. NN = IPT1.NUM(/1)
  392. C
  393. C --------------------- NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
  394. C
  395. NFRQ = MLREE1.PROG(/1)
  396. C
  397. IF (IDEPL.EQ.1.AND.NFRQ.NE.1) THEN
  398. WRITE(6,*)'ERREUR*********************************'
  399. WRITE(6,*)' '
  400. WRITE(6,*)'ON NE PEUT DONNER LA DEFORMEE QUE POUR'
  401. WRITE(6,*)'UNE SEULE FREQENCE (LISTREEL DE LONG 1)'
  402. RETURN
  403. END IF
  404. C
  405. C
  406. C --------------------- DETERMINATION DU NOMBRE DE NOEUDS DU MAILLAGE
  407. C ---------------------------------------------
  408. NNNP = NN*NP
  409. SEGINI AUXI
  410. ICOMP = 0
  411. DO 10 I = 1 , NP
  412. DO 11 J = 1 , NN
  413. AUXI.IAUXI(ICOMP+1) = IPT1.NUM(J,I)
  414. C
  415. IF (ICOMP.LT.1) THEN
  416. ITEST = 0
  417. GOTO 13
  418. END IF
  419. C
  420. ITEST = 0
  421. DO 12 K = 1 , ICOMP
  422. IF (AUXI.IAUXI(K).EQ.IPT1.NUM(J,I)) ITEST = 1
  423. 12 CONTINUE
  424. C
  425. 13 IF (ITEST.EQ.0) ICOMP = ICOMP + 1
  426. C
  427. 11 CONTINUE
  428. C
  429. 10 CONTINUE
  430. C
  431. SEGSUP AUXI
  432. C
  433. NNT = ICOMP
  434. C
  435. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  436. C
  437. IF (IMP.NE.0) THEN
  438. WRITE (IMP,*) 'NOMBRE TOTAL DE NOEUD DU MAILLAGE :',NNT
  439. END IF
  440. C
  441. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  442. C
  443. C --------------------- INITIALISATION DES TABLEAUX DE TRAVAIL
  444. C --------------------------------------
  445. NP2 = NP * 2
  446. NP12 = NP * 12
  447. NP24 = NP * 24
  448. NP48 = NP * 48
  449. NNT12 = NNT * 12
  450. C
  451. SEGINI MATRES
  452. C
  453. C ------------------- SI NON METHODE ITERATIVE, SEGMENT MATITE INUTILE
  454. C ------------------------------------------------
  455. IF (METH.LT.3) THEN
  456. NP48 = 48
  457. END IF
  458. C
  459. SEGINI MATITE
  460. C
  461. NUMP = 0
  462. C
  463. DO 20 INP = 1 , NP
  464. C
  465. IP1 = IPT1.NUM(1,INP)
  466. C
  467. C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
  468. C -------------------------------------
  469. IF (NUMP.EQ.0) THEN
  470. NUMP = NUMP + 1
  471. MATRES.NUMERO ( NUMP ) = IP1
  472. ELSE
  473. NON = 0
  474. DO 21 I = 1 , NUMP
  475. IF (MATRES.NUMERO(I).EQ.IP1) THEN
  476. NON = 1
  477. END IF
  478. 21 CONTINUE
  479. C
  480. IF (NON.EQ.0) THEN
  481. NUMP = NUMP + 1
  482. MATRES.NUMERO ( NUMP ) = IP1
  483. END IF
  484. END IF
  485. C
  486. IP2 = IPT1.NUM(2,INP)
  487. C
  488. C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
  489. C -------------------------------------
  490. NON = 0
  491. DO 22 I = 1 , NUMP
  492. IF (MATRES.NUMERO(I).EQ.IP2) THEN
  493. NON = 1
  494. END IF
  495. 22 CONTINUE
  496. C
  497. IF (NON.EQ.0) THEN
  498. NUMP = NUMP + 1
  499. MATRES.NUMERO ( NUMP ) = IP2
  500. END IF
  501. C
  502. C
  503. C -------------------- COOR : TABLEAU DES COORDONNEES
  504. C --------------------------------
  505. MATRES.COOR(1,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
  506. MATRES.COOR(2,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
  507. MATRES.COOR(3,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
  508. MATRES.COOR(1,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+1)
  509. MATRES.COOR(2,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+2)
  510. MATRES.COOR(3,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+3)
  511. C
  512. C -------------------- CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
  513. C --------------------------------------------
  514. C
  515. MATRES.CORRES(2*INP-1) = IP1
  516. MATRES.CORRES(2*INP ) = IP2
  517. C
  518. 20 CONTINUE
  519. C
  520. C
  521. C **********************************************************************
  522. C LECTURE DU CHPOINT (CONDITIONS AUX LIMITES)
  523. C **********************************************************************
  524. C
  525. C -------------------- XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
  526. C ---------- AUX LIMITES POUR CHAQUE NOEUD.
  527. C
  528. NSOUPO = MCHPO1.IPCHP(/1)
  529. C
  530. IMAS = 0
  531. C
  532. DO 25 I = 1 , NNT
  533. DO 25 J = 1 , 12
  534. MATRES.XCL(J,I) = 0.E0
  535. MATRES.FLAG((I-1)*NNT+J) = 0
  536. 25 CONTINUE
  537. C
  538. DO 30 I = 1 , NSOUPO
  539. C
  540. MSOUP1 = MCHPO1.IPCHP(I)
  541. SEGACT MSOUP1
  542. C
  543. IPT2 = MSOUP1.IGEOC
  544. SEGACT IPT2
  545. C
  546. MPOVA2 = MSOUP1.IPOVAL
  547. SEGACT MPOVA2
  548. C
  549. NC = MSOUP1.NOCOMP(/2)
  550. N = MPOVA2.VPOCHA(/1)
  551. C
  552. DO 31 J = 1 , N
  553. C
  554. C -- ON CHERCHE NUM(1,J) CAR DANS UN CHAMP PAR POINTS, LES
  555. C -- ELEMENTS DES SOUS-MAILLAGES ELEMENTAIRES SONT LES POINTS
  556. C -- DE CES SOUS-MAILLAGES, ET CHAQUE ELEMENT CONTIENT DONC UN
  557. C -- SEUL NOEUD
  558. C
  559. NOEUD = IPT2.NUM(1,J)
  560. ISTOP = 0
  561. C
  562. DO 33 K = 1 , NNT
  563. IF (MATRES.NUMERO(K).EQ.NOEUD) THEN
  564. NNOEUD = K
  565. END IF
  566. 33 CONTINUE
  567. C
  568. DO 32 K = 1 , NC
  569. COMP = MSOUP1.NOCOMP(K)
  570. CALL ELLP09(COMP,ICOMP,IERROR)
  571. IF (IERROR.NE.0) THEN
  572. RETURN
  573. END IF
  574. C
  575. IF (ICOMP.GE.13.AND.ISTOP.EQ.0) THEN
  576. IMAS = IMAS + 1
  577. ISTOP = 1
  578. END IF
  579. IF (ICOMP.EQ.13) THEN
  580. DO 35 II = 2*NP , 1 , -1
  581. IF (CORRES(II).EQ.NOEUD) THEN
  582. MATRES.MASS(IMAS,1) = II
  583. END IF
  584. 35 CONTINUE
  585. C
  586. MATRES.MASS(IMAS,2) = INT((MATRES.MASS(IMAS,1)+1)/2)
  587. II = MATRES.MASS(IMAS,1)
  588. JJ = INT(II/2)*2
  589. IF (II.EQ.JJ) THEN
  590. MATRES.MASS(IMAS,3) = 24*(MATRES.MASS(IMAS,2)-1)+13
  591. ELSE
  592. MATRES.MASS(IMAS,3) = 24*(MATRES.MASS(IMAS,2)-1)+1
  593. END IF
  594. C
  595. MATRES.RMAS(IMAS,1) = MPOVA2.VPOCHA(J,K)
  596. C
  597. ELSE IF (ICOMP.GT.13) THEN
  598. JMAS = ICOMP - 12
  599. MATRES.RMAS(IMAS,JMAS) = MPOVA2.VPOCHA(J,K)
  600. C
  601. ELSE
  602. C
  603. MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
  604. MATRES.FLAG((NNOEUD-1)*12+ICOMP)=NNOEUD
  605. END IF
  606. C
  607. 32 CONTINUE
  608. 31 CONTINUE
  609. C
  610. WRITE(6,*)'FIN D IMPRESSION'
  611. DO 34 IN = 1 , NNT12 , 3
  612. IF (MATRES.FLAG(IN ).NE.0.OR.
  613. * MATRES.FLAG(IN+1).NE.0.OR.
  614. * MATRES.FLAG(IN+2).NE.0) THEN
  615. MATRES.FLAG(IN ) = INT((IN-1)/12) + 1
  616. MATRES.FLAG(IN+1) = INT((IN-1)/12) + 1
  617. MATRES.FLAG(IN+2) = INT((IN-1)/12) + 1
  618. END IF
  619. 34 CONTINUE
  620. C
  621. SEGDES IPT2
  622. SEGDES MPOVA2
  623. SEGDES MSOUP1
  624. C
  625. 30 CONTINUE
  626. C
  627. NMAS = IMAS
  628. C
  629. C
  630. C **********************************************************************
  631. C LECTURE DU NOUVEAU CHAMLEM (CARACTERISTIQUES DU MATERIAU)
  632. C **********************************************************************
  633. C
  634. C
  635. C .................... CARACT : TABLEAU DES CARACTERISTIQUES
  636. C
  637. NN1 = MCHEL1.IMACHE(/1)
  638. C
  639. DO 700 I = 1 , NN1
  640. C
  641. IPT3 = MCHEL1.IMACHE(I)
  642. MCHAM1 = MCHEL1.ICHAML(I)
  643. C
  644. SEGACT IPT3
  645. NBE = IPT3.NUM(/2)
  646. C
  647. SEGACT MCHAM1
  648. NN2 = MCHAM1.IELVAL(/1)
  649. C
  650. DO 713 II = 1 , NN2
  651. C
  652. CALL ELLP08(MCHAM1.NOMCHE(II),ICARAC,IERROR)
  653. IF (IERROR.NE.0) THEN
  654. RETURN
  655. END IF
  656. C
  657. IF (ICARAC.NE.6) THEN
  658. MELVA1 = MCHAM1.IELVAL(II)
  659. SEGACT MELVA1
  660. XCARAC = MELVA1.VELCHE(1,1)
  661. SEGDES MELVA1
  662. ELSE
  663. MELVA1 = MCHAM1.IELVAL(II)
  664. SEGACT MELVA1
  665. IPP = MELVA1.IELCHE(1,1)
  666. X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
  667. X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
  668. X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
  669. SEGDES MELVA1
  670. END IF
  671. C
  672. DO 716 IE = 1 , NBE
  673. INU1 = IPT3.NUM(1,IE)
  674. INU2 = IPT3.NUM(2,IE)
  675. C
  676. NCARAC = 0
  677. C
  678. DO 717 III = 1 , NP2 , 2
  679. IN1 = MATRES.CORRES(III )
  680. IN2 = MATRES.CORRES(III+1)
  681. IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
  682. NCARAC = INT(III/2) + 1
  683. END IF
  684. C
  685. IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
  686. NCARAC = INT(III/2) + 1
  687. END IF
  688. C
  689. 717 CONTINUE
  690. C
  691. IF (ICARAC.NE.6) THEN
  692. MATRES.CARACT(ICARAC,NCARAC) = XCARAC
  693. ELSE
  694. MATRES.GAMA(1,NCARAC) = X1
  695. MATRES.GAMA(2,NCARAC) = X2
  696. MATRES.GAMA(3,NCARAC) = X3
  697. END IF
  698. C
  699. 716 CONTINUE
  700. C
  701. 713 CONTINUE
  702. C
  703. SEGDES MCHAM1
  704. SEGDES IPT3
  705. C
  706. 700 CONTINUE
  707. C
  708. C -------------------------- ENTREE DU MOMENT POLAIRE IP = IY + IZ
  709. C -------------------------------------
  710. DO 40 I = 1 , NP
  711. MATRES.CARACT ( 6, I ) = MATRES.CARACT ( 7, I)
  712. * + MATRES.CARACT ( 8, I )
  713. 40 CONTINUE
  714. C
  715. C -------------------------- CALCUL DE LA VALEUR REEL DE NPOI
  716. C --------------------------------
  717. DO 50 I = 1 , NNT
  718. IF (MATRES.NUMERO(I).EQ.NPOI) THEN
  719. NNPOI = I
  720. END IF
  721. 50 CONTINUE
  722. C
  723. SEGDES IPT1
  724. SEGDES MCHPO1
  725. SEGDES MCHEL1
  726. C
  727. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  728. C
  729. IF (IMP.NE.0) THEN
  730. C
  731. C ----------------------------------------------------------------------
  732. C
  733. C IMPRESSION DES TABLEAUX CREES A L'INTERFACE
  734. C
  735. C - COOR ( 3 , 2*NP )
  736. C - CORRES ( 2*NP )
  737. C - GAMA ( 3 , NP )
  738. C - CARACT (12 , NP )
  739. C - XCL (12 , NNT )
  740. C - FLAG ( 12*NNT )
  741. C - NUMERO ( NNT )
  742. C - MASS ( NMAS , 3 )
  743. C - RMAS ( NMAS , 4)
  744. C
  745. C ----------------------------------------------------------------------
  746. C
  747. WRITE (IMP,*) 'TABLEAU COOR :'
  748. WRITE (IMP,*) '************'
  749. C
  750. DO 980 I = 1 , 2*NP
  751. WRITE (IMP,*) 'NOEUD ',I,':',
  752. * MATRES.COOR(1,I),MATRES.COOR(2,I),MATRES.COOR(3,I)
  753. 980 CONTINUE
  754. C
  755. WRITE (IMP,*) 'TABLEAU CORRES :'
  756. WRITE (IMP,*) '**************'
  757. C
  758. DO 981 I = 1 , 2*NP
  759. WRITE (IMP,*) 'NOEUD ',I,':',MATRES.CORRES(I)
  760. 981 CONTINUE
  761. C
  762. C
  763. WRITE (IMP,*) 'TABLEAU NUMERO :'
  764. WRITE (IMP,*) '**************'
  765. C
  766. DO 987 I = 1 , NNT
  767. WRITE (IMP,*) 'NOEUD ',I,':',MATRES.NUMERO(I)
  768. 987 CONTINUE
  769. C
  770. WRITE (IMP,*) 'TABLEAU GAMA :'
  771. WRITE (IMP,*) '************'
  772. C
  773. DO 982 I = 1 , NP
  774. WRITE (IMP,*) 'POUTRE ',I,':',
  775. * MATRES.GAMA(1,I),MATRES.GAMA(2,I),MATRES.GAMA(3,I)
  776. 982 CONTINUE
  777. C
  778. WRITE (IMP,*) 'TABLEAU CARACT :'
  779. WRITE (IMP,*) '**************'
  780. C
  781. DO 983 I = 1 , NP
  782. WRITE (IMP,*) 'E : ',MATRES.CARACT ( 1 , I)
  783. WRITE (IMP,*) 'NU : ',MATRES.CARACT ( 2 , I)
  784. WRITE (IMP,*) 'RHO : ',MATRES.CARACT ( 3 , I)
  785. WRITE (IMP,*) 'SEC : ',MATRES.CARACT ( 4 , I)
  786. WRITE (IMP,*) 'C : ',MATRES.CARACT ( 5 , I)
  787. WRITE (IMP,*) 'IP : ',MATRES.CARACT ( 6 , I)
  788. WRITE (IMP,*) 'IY : ',MATRES.CARACT ( 7 , I)
  789. WRITE (IMP,*) 'IZ : ',MATRES.CARACT ( 8 , I)
  790. WRITE (IMP,*) 'KCY : ',MATRES.CARACT ( 9 , I)
  791. WRITE (IMP,*) 'KCZ : ',MATRES.CARACT (10 , I)
  792. WRITE (IMP,*) 'CAM : ',MATRES.CARACT (11 , I)
  793. WRITE (IMP,*) 'ETA : ',MATRES.CARACT (12 , I)
  794. 983 CONTINUE
  795. C
  796. WRITE (IMP,*) 'TABLEAU XCL :'
  797. WRITE (IMP,*) '***********'
  798. C
  799. DO 984 I = 1 , 12
  800. DO 985 J = 1 , NNT
  801. WRITE (IMP,*) I , J,':',MATRES.XCL (I,J)
  802. 985 CONTINUE
  803. 984 CONTINUE
  804. C
  805. WRITE (IMP,*) 'TABLEAU FLAG :'
  806. WRITE (IMP,*) '************'
  807. C
  808. DO 986 I = 1 , 12*NNT
  809. WRITE (IMP,*) 'VAL ',I,':',MATRES.FLAG ( I )
  810. 986 CONTINUE
  811. C
  812. WRITE(IMP,*)'NMAS',NMAS
  813. C
  814. IF (NMAS.GT.0) THEN
  815. DO 988 I = 1 , NMAS
  816. WRITE (IMP,*) 'MASS (',I,',1) :',MATRES.MASS(I,1)
  817. WRITE (IMP,*) 'MASS (',I,',2) :',MATRES.MASS(I,2)
  818. WRITE (IMP,*) 'MASS (',I,',3) :',MATRES.MASS(I,3)
  819. WRITE (IMP,*) 'MASS (',I,',4) :',MATRES.MASS(I,4)
  820. 988 CONTINUE
  821. C
  822. DO 989 I = 1 , NMAS
  823. WRITE (IMP,*) 'RMAS (',I,',1) :',MATRES.RMAS(I,1)
  824. WRITE (IMP,*) 'RMAS (',I,',2) :',MATRES.RMAS(I,2)
  825. WRITE (IMP,*) 'RMAS (',I,',3) :',MATRES.RMAS(I,3)
  826. WRITE (IMP,*) 'RMAS (',I,',4) :',MATRES.RMAS(I,4)
  827. 989 CONTINUE
  828. END IF
  829. C
  830. END IF
  831. C
  832. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  833. C
  834. C ----------------------------------------------------------------------
  835. C
  836. C APPEL DU PROGRAMME FORTRAN POUR LA RESOLUTION DU PROBLEME
  837. C
  838. C TABLEAUX D'ENTREE :
  839. C
  840. C COOR(3,2*NP), CORRES(2*NP), GAMA(3,NP), CARACT(12,NP),
  841. C XCL(12,NNT) , FLAG (12*NNT), NUMERO (NNT) (NP NOMBRE DE POUTRES
  842. C NNT NOMBRE REEL DE NOEUDS)
  843. C
  844. C TABLEAUX DE SORTIE :
  845. C
  846. C ZA1(24*NP,24*NP) , ZSM (24*NP) , ZXX (24*NP)
  847. C
  848. C ----------------------------------------------------------------------
  849. C
  850. CALL ELLP11(MATRES.COOR , MATRES.CORRES , MATRES.GAMA ,
  851. * MATRES.CARACT , MATRES.XCL , MATRES.FLAG ,
  852. * MATRES.NUMERO , MATRES.ZA1 , MATRES.ZSM ,
  853. * MATRES.ZXX , MATRES.ZSOL , MATITE.ITERA ,
  854. * MATRES.MASS , MATRES.RMAS , NMAS ,
  855. * MATITE.SA , MATITE.SB , MATITE.SU ,
  856. * MATITE.SR , MATITE.SQ , MATITE.SDELTA,
  857. * MATITE.SDELT1 , MATITE.SP , MATITE.SP1 ,
  858. * MATITE.SCH , MATITE.SCH1 , MATRES.IPIVO ,
  859. * MATRES.JPIVO , MATRES.IAUX , MLREE1.PROG ,
  860. * NNPOI,ICHAR,NP,NP24,NP48,NNT,NNT12,NFRQ,S0,XPI,METH,IMP)
  861. C
  862. ZS = S0 + (0.D0 , 1.D0 ) * 2. * XPI * MLREE1.PROG(1)
  863. C
  864. C
  865. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  866. IF (IMP.NE.0) THEN
  867. WRITE (IMP,*)'VECTEUR SOLUTION ZSOL (PREMIERE FREQUENCE) :'
  868. DO 42 J = 1 , NNT12
  869. WRITE (IMP,*) J,MATRES.ZSOL(J,1)
  870. 42 CONTINUE
  871. C
  872. END IF
  873. C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
  874. C
  875. IF (IDEPL.EQ.0) THEN
  876. C
  877. JG = NFRQ
  878. SEGINI MLREE2
  879. SEGINI MLREE3
  880. SEGINI MLREE4
  881. C
  882. DO 100 I = 1 , NFRQ
  883. C
  884. MLREE2.PROG(I) = ABS(MATRES.ZSOL((NNPOI-1)*12+ICHAR,I))
  885. C
  886. ZT = MATRES.ZSOL((NNPOI-1)*12+ICHAR,I)
  887. PRZT = ZT
  888. PIZT = ZT*(0.D0,-1.D0)
  889. C
  890. IF (ABS(PRZT).LT.XPETIT.AND.ABS(PIZT).LT.XPETIT) THEN
  891. MLREE3.PROG(I) = 0.D0
  892. ELSE
  893. MLREE3.PROG(I) = ATAN2(PIZT,PRZT)*180.D0/XPI
  894. END IF
  895. C
  896. MLREE4.PROG(I) = MATITE.ITERA(I)
  897. 100 CONTINUE
  898. C
  899. C ------------------- OUVERTURE DU SEGMENT RESULTAT TYPE EVOLUTION
  900. C --------------------------------------------
  901. C
  902. N = 3
  903. SEGINI MEVOL1
  904. SEGINI KEVOL1
  905. SEGINI KEVOL2
  906. SEGINI KEVOL3
  907. C
  908. MEVOL1.ITYEVO = 'REEL'
  909. C MEVOL1.IEVTEX = 'OPERATEUR ELFE LAPLACE POUTRE'
  910. MEVOL1.IEVOLL(1) = KEVOL1
  911. MEVOL1.IEVOLL(2) = KEVOL2
  912. MEVOL1.IEVOLL(3) = KEVOL3
  913. C
  914. C
  915. KEVOL1.IPROGX = MLREE1
  916. KEVOL1.IPROGY = MLREE2
  917. C KEVOL1.NUMEVY = 'MODU'
  918. KEVOL1.TYPX = 'LISTREEL'
  919. KEVOL1.TYPY = 'LISTREEL'
  920. KEVOL1.NOMEVX = 'FREQ (HZ)'
  921. KEVOL1.NOMEVY = CHAR
  922. C KEVOL1.KEVTEX = '********'
  923. C
  924. C
  925. KEVOL2.IPROGX = MLREE1
  926. KEVOL2.IPROGY = MLREE3
  927. C KEVOL2.NUMEVY = 'PHAS'
  928. KEVOL2.TYPX = 'LISTREEL'
  929. KEVOL2.TYPY = 'LISTREEL'
  930. KEVOL2.NOMEVX = 'FREQ (HZ)'
  931. KEVOL2.NOMEVY = CHAR
  932. C KEVOL2.KEVTEX = '********'
  933. C
  934. KEVOL3.IPROGX = MLREE1
  935. KEVOL3.IPROGY = MLREE4
  936. KEVOL3.NUMEVY = 'ITER'
  937. KEVOL3.TYPX = 'LISTREEL'
  938. KEVOL3.TYPY = 'LISTREEL'
  939. KEVOL3.NOMEVX = 'FREQ (HZ)'
  940. KEVOL3.NOMEVY = CHAR
  941. C KEVOL3.KEVTEX = 'ITERATION'
  942. C
  943. CALL ECROBJ('EVOLUTION',MEVOL1)
  944. C
  945. SEGDES KEVOL1
  946. SEGDES KEVOL2
  947. SEGDES KEVOL3
  948. SEGDES MEVOL1
  949. SEGDES MLREE2
  950. SEGDES MLREE3
  951. SEGDES MLREE4
  952. C
  953. ELSE
  954. C
  955. DO 230 I = 1 , 2
  956. DO 240 J = 1 , NBELEM
  957. IP1 = IPT4.NUM(I,J)
  958. MATRES.XCOR(I,1,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
  959. MATRES.XCOR(I,2,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
  960. MATRES.XCOR(I,3,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
  961. 240 CONTINUE
  962. 230 CONTINUE
  963. C
  964. CALL ELLP23(MATRES.CARACT , MATRES.COOR , MATRES.GAMA ,
  965. * MATRES.ZXX , MATRES.XCOR , MATRES.VALDE1,
  966. * MATRES.VALDE2 , ZS , NP , NBELEM ,XPI )
  967. C
  968. N1 = 1
  969. N2 = 6
  970. L1=0
  971. N3=0
  972. SEGINI MCHEL1
  973. SEGINI MCHAM1
  974. MCHEL1.IMACHE(1) = IPT4
  975. MCHEL1.CONCHE(1) = ' '
  976. MCHEL1.ICHAML(1) = MCHAM1
  977. C
  978. MCHAM1.NOMCHE(1) = 'UXM'
  979. MCHAM1.NOMCHE(2) = 'UYM'
  980. MCHAM1.NOMCHE(3) = 'UZM'
  981. MCHAM1.NOMCHE(4) = 'UXP'
  982. MCHAM1.NOMCHE(5) = 'UYP'
  983. MCHAM1.NOMCHE(6) = 'UZP'
  984. MCHAM1.TYPCHE(1) = 'REAL*8'
  985. MCHAM1.TYPCHE(2) = 'REAL*8'
  986. MCHAM1.TYPCHE(3) = 'REAL*8'
  987. MCHAM1.TYPCHE(4) = 'REAL*8'
  988. MCHAM1.TYPCHE(5) = 'REAL*8'
  989. MCHAM1.TYPCHE(6) = 'REAL*8'
  990. C
  991. N1PTEL = 2
  992. N1EL = NBELEM
  993. N2PTEL = 0
  994. N2EL = 0
  995. C
  996. SEGINI MELVA1
  997. SEGINI MELVA2
  998. SEGINI MELVA3
  999. SEGINI MELVA4
  1000. SEGINI MELVA5
  1001. SEGINI MELVA6
  1002. C
  1003. MCHAM1.IELVAL(1) = MELVA1
  1004. MCHAM1.IELVAL(2) = MELVA2
  1005. MCHAM1.IELVAL(3) = MELVA3
  1006. MCHAM1.IELVAL(4) = MELVA4
  1007. MCHAM1.IELVAL(5) = MELVA5
  1008. MCHAM1.IELVAL(6) = MELVA6
  1009. C
  1010. DO 200 I = 1 , 2
  1011. DO 210 J = 1 , NBELEM
  1012. MELVA1.VELCHE(I,J) = VALDE1 ( I , J , 1 )
  1013. MELVA2.VELCHE(I,J) = VALDE1 ( I , J , 2 )
  1014. MELVA3.VELCHE(I,J) = VALDE1 ( I , J , 3 )
  1015. MELVA4.VELCHE(I,J) = VALDE2 ( I , J , 1 )
  1016. MELVA5.VELCHE(I,J) = VALDE2 ( I , J , 2 )
  1017. MELVA6.VELCHE(I,J) = VALDE2 ( I , J , 3 )
  1018. 210 CONTINUE
  1019. 200 CONTINUE
  1020. C
  1021. * NSOUPO = 1
  1022. * NAT=1
  1023. * SEGINI MCHPO1
  1024. CALL CHAMPO(MCHEL1,1,MCHPO1,IRET)
  1025. CALL ECROBJ('CHPOINT',MCHPO1)
  1026. C
  1027. SEGDES MELVA1
  1028. SEGDES MELVA2
  1029. SEGDES MELVA3
  1030. SEGDES MELVA4
  1031. SEGDES MELVA5
  1032. SEGDES MELVA6
  1033. SEGDES MCHAM1
  1034. SEGDES MCHEL1
  1035. SEGDES MCHPO1
  1036. C
  1037. END IF
  1038. C
  1039. SEGDES MLREE1
  1040. SEGSUP MATRES
  1041. SEGSUP MATITE
  1042. C
  1043. END
  1044.  
  1045.  
  1046.  
  1047.  
  1048.  
  1049.  
  1050.  
  1051.  
  1052.  

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