Télécharger ense.eso

Retour à la liste

Numérotation des lignes :

  1. C ENSE SOURCE PV 16/11/17 21:59:17 9180
  2. SUBROUTINE ENSE
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC SMCHPOI
  6. -INC SMELEME
  7. -INC CCOPTIO
  8. -INC SMRIGID
  9. -INC SMMATRI
  10. -INC SMSOLUT
  11. SEGMENT ITRAV(NENS)
  12. integer insym
  13. insym = 0
  14. C
  15. CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU)
  16. IF(IERR.NE.0) RETURN
  17. SEGACT MRIGID
  18. *
  19. * ON TESTE SI IL Y A DES RIGIDITES UNILATERALES
  20. *
  21. DO 4 I=1,IRIGEL(/2)
  22. IF(IRIGEL(6,I).NE.0) THEN
  23. CALL ERREUR(433)
  24. SEGDES MRIGID
  25. RETURN
  26. ENDIF
  27. 4 CONTINUE
  28. *
  29. IIFO=IFORIG
  30. C
  31. NRG = IRIGEL(/1)
  32. NBR = IRIGEL(/2)
  33. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
  34. INSYM = 1
  35. ENDIF
  36. IF (NRG.GE.7) THEN
  37. DO 9 IN = 1,NBR
  38. IANTI=IRIGEL(7,IN)
  39. IF(IANTI.GT.0) THEN
  40. INSYM = 1
  41. ENDIF
  42. 9 CONTINUE
  43. ENDIF
  44. CALL ECROBJ ('RIGIDITE',MRIGID)
  45. CALL RESOU
  46. IF (IERR.NE.0) RETURN
  47. SEGACT,MRIGID
  48. MRISAU=MRIGID
  49. IF (JRCOND.NE.0) THEN
  50. MRIGID=JRCOND
  51. SEGACT MRIGID
  52. ENDIF
  53. MMATRI=ICHOLE
  54. SEGACT MMATRI
  55. IF(NENS.EQ.0) THEN
  56. SEGDES MMATRI
  57. CALL ERREUR(327)
  58. RETURN
  59. ENDIF
  60. MRIGID=MRISAU
  61. C
  62. C ON MET DANS ITRAV LE NUMERO DES LIGNES OU LES MVTS D'ENSEMBLES
  63. C ONT ETE DETECTES
  64. C
  65. MILIGN=IILIGN
  66. SEGACT MILIGN
  67. SEGINI ITRAV
  68. DO 1 I=ILIGN(/1),1,-1
  69. LIGN=ILIGN(I)
  70. SEGACT LIGN
  71. DO 1501 IIJ=IMMM(/1),1,-1
  72. IN=IMMM(IIJ)
  73. IF(IN.EQ.0) GO TO 1501
  74. ITRAV(IN)=IIJ +IPREL-1
  75. IF(IN.EQ.1) GO TO 2
  76. 1501 CONTINUE
  77. SEGDES LIGN
  78. 1 CONTINUE
  79. C
  80. C ON N'A PAS TROUVER LE NOMBRE DE MODE D'ENSEMBLE VOULU
  81. C
  82. CALL ERREUR (5)
  83. SEGSUP ITRAV
  84. SEGDES MMATRI,MILIGN
  85. RETURN
  86. 2 CONTINUE
  87. C
  88. C FABRICATION DES CHPOINT SECOND MEMBRE BOUCLE 10
  89. C
  90. IPT1=IGEOMA
  91. MINCPO=IINCPO
  92. MIDUA=IIDUA
  93. MHARK=IHARK
  94. MDIAG=IDIAG
  95. SEGACT MINCPO,MIDUA,MHARK,IPT1,MDIAG
  96. NSOUPO=1
  97. NC=1
  98. N=1
  99. NBNN=1
  100. NBELEM=1
  101. NBREF=0
  102. NBSOUS=0
  103. NAT=1
  104. DO 10 I=1,NENS
  105. SEGINI MCHPOI
  106. IFOPOI=IIFO
  107. C les modes solutions sont des chpo de type diffus
  108. JATTRI(1)=2
  109. SEGINI MSOUPO
  110. IPCHP(1)=MSOUPO
  111. SEGINI MELEME
  112. IGEOC=MELEME
  113. ITYPEL=1
  114. C
  115. C RECHERCHE DU NUMERO DU NOEUD ET DU NOM DE L'INCONNUES PAR
  116. C L'INTERMEDIAIRE DU TABLEAU INCPO
  117. C
  118. IA=ITRAV(I)
  119. DO 11 J=INCPO(/2),1,-1
  120. j1=J
  121. DO 11 K=1,INCPO(/1)
  122. k1= K
  123. IF(INCPO(K,J).EQ.IA) GO TO 12
  124. 11 CONTINUE
  125. C
  126. C ERREUR PAS NORMALE
  127. C
  128. CALL ERREUR(5)
  129. RETURN
  130. 12 CONTINUE
  131. NUM(1,1)=IPT1.NUM(1,J1)
  132. NOCOMP(1)=IDUA(K1)
  133. NOHARM(1)=IHAR(K1)
  134. SEGINI MPOVAL
  135. IPOVAL=MPOVAL
  136. VPOCHA(1,1)=DIAG(IA)
  137. SEGDES MPOVAL,MELEME,MSOUPO,MCHPOI
  138. ITRAV(I)=MCHPOI
  139. 10 CONTINUE
  140. C
  141. C ON VA APPELE RESOU
  142. C
  143. SEGDES MINCPO,MIDUA,MHARK,IPT1,MDIAG
  144. SEGDES MMATRI,MRIGID,MILIGN
  145. DO 20 I=1,ITRAV(/1)
  146. ITRA=ITRAV(I)
  147. CALL ECROBJ ('CHPOINT ',ITRA)
  148. 20 CONTINUE
  149. CALL ECROBJ ('RIGIDITE',MRIGID)
  150. CALL ECRCHA ('ENSE')
  151. CALL RESOU
  152. * resou sort le nombre de modes d'ensemble
  153. CALL LIRENT(I,1,iretou)
  154. * et le maillage des noeuds contraints
  155. call lirobj('MAILLAGE',ipt8,1,iretou)
  156. IF(IERR.NE.0) RETURN
  157. DO 21 I=1,ITRAV(/1)
  158. CALL LIROBJ('CHPOINT ',ICHP,1,IRETOU)
  159. IF(IERR.NE.0) THEN
  160. CALL ERREUR(5)
  161. RETURN
  162. ENDIF
  163. MCHPOI=ITRAV(I)
  164. SEGACT MCHPOI
  165. MSOUPO=IPCHP(1)
  166. SEGACT MSOUPO
  167. MELEME=IGEOC
  168. MPOVAL=IPOVAL
  169. SEGSUP MPOVAL,MELEME
  170. SEGSUP MSOUPO
  171. SEGSUP MCHPOI
  172. ITRAV(I)=ICHP
  173. 21 CONTINUE
  174. C
  175. C ON ORTHOGONALISE LES VECTEURS LES UNS PAR RAPPORT AUX AUTRES
  176. C
  177. DO 40 I=1,ITRAV(/1)
  178. MCHPOI=ITRAV(I)
  179. C
  180. C ON CALCULE LES PRODUIT XJ * XI AVEC J < I PUIS ON FAIT
  181. C XI = XI - (XJ*XI) XJ
  182. C
  183. SEGACT MCHPOI
  184. DO 39 J = 1,IPCHP(/1)
  185. MSOUPO=IPCHP(J)
  186. SEGACT MSOUPO
  187. MPOVAL=IPOVAL
  188. SEGACT MPOVAL*MOD
  189. 39 CONTINUE
  190. IF(I.EQ.1) GO TO 47
  191. I1= I -1
  192. DO 41 J = 1,I1
  193. MCHPO1=ITRAV(J)
  194. SEGACT MCHPO1
  195. AA=0.D0
  196. NSOUPO=IPCHP(/1)
  197. DO 42 K=1,NSOUPO
  198. MSOUPO=IPCHP(K)
  199. MSOUP1=MCHPO1.IPCHP(K)
  200. SEGACT MSOUP1
  201. MPOVAL=IPOVAL
  202. MPOVA1=MSOUP1.IPOVAL
  203. SEGACT MPOVA1
  204. DO 43 L=1,VPOCHA(/2)
  205. DO 43 M=1,VPOCHA(/1)
  206. AA=AA+VPOCHA(M,L)*MPOVA1.VPOCHA(M,L)
  207. 43 CONTINUE
  208. 42 CONTINUE
  209. DO 44 K=1,NSOUPO
  210. MSOUPO=IPCHP(K)
  211. MPOVAL=IPOVAL
  212. MSOUP1=MCHPO1.IPCHP(K)
  213. MPOVA1=MSOUP1.IPOVAL
  214. DO 45 L=1,VPOCHA(/2)
  215. DO 45 M=1,VPOCHA(/1)
  216. VPOCHA(M,L)=VPOCHA(M,L)- AA * MPOVA1.VPOCHA(M,L)
  217. 45 CONTINUE
  218. 44 CONTINUE
  219. SEGDES MPOVA1,MSOUP1,MCHPO1
  220. 41 CONTINUE
  221. 47 CONTINUE
  222. C
  223. C ON NORME LE VECTEUR TROUVE
  224. C
  225. BB=0.D0
  226. DO 50 J = 1, IPCHP(/1)
  227. MSOUPO=IPCHP(J)
  228. MPOVAL=IPOVAL
  229. DO 51 K=1,VPOCHA(/2)
  230. DO 51 L=1,VPOCHA(/1)
  231. BB = BB + VPOCHA(L,K)*VPOCHA(L,K)
  232. 51 CONTINUE
  233. 50 CONTINUE
  234. IF( BB . EQ.0.D0 ) THEN
  235. CALL ERREUR(5)
  236. RETURN
  237. ENDIF
  238. CC = 1.D0/(SQRT(BB))
  239. DO 52 J = 1, IPCHP(/1)
  240. MSOUPO=IPCHP(J)
  241. MPOVAL=IPOVAL
  242. DO 53 K=1,VPOCHA(/2)
  243. DO 53 L=1,VPOCHA(/1)
  244. VPOCHA(L,K)=VPOCHA(L,K)*CC
  245. 53 CONTINUE
  246. SEGDES MPOVAL,MSOUPO
  247. 52 CONTINUE
  248. SEGDES MCHPOI
  249. 40 CONTINUE
  250. C
  251. C ON CREE UN OBJET SOLUT PAR MODE ET ON FUSIONNE
  252. C
  253. DO 30 IIM=1,ITRAV(/1)
  254. IPCH=ITRAV(IIM)
  255. LVALM=5
  256. NIMOD=3
  257. NIPO=5
  258. SEGINI MSOLUT
  259. SEGINI MMODE
  260. MSOLIS(4)=MMODE
  261. MSOLIS(5)=IPCH
  262. IMMODD(1)=IIM
  263. MCHPOI=MSOLIS(5)
  264. SEGACT MCHPOI
  265. IF(IFOPOI.NE.1) GOTO 101
  266. ICHPOI=MCHPOI
  267. CALL NUHARM(ICHPOI,IFO,IHARM)
  268. MCHPOI=ICHPOI
  269. IF(IFO.NE.1) THEN
  270. IMMODD(2)=0
  271. IMMODD(3)=0
  272. ELSE
  273. IMMODD(2)=IHARM
  274. IF(IHARM.LT.0)IMMODD(3)=1
  275. IF(IHARM.GE.0)IMMODD(3)=2
  276. ENDIF
  277. 101 CONTINUE
  278. SEGDES MCHPOI
  279. SEGDES MMODE
  280. ITYSOL='MODE '
  281. C
  282. C
  283. C **** ON CREE LE NOEUD NBNO+1 QUI VA ETRE ASSOCIE AU MODE.
  284. C **** ON MET CE NOEUD A L ORIGINE. IL VA SERVIR D INDICE AU MODE
  285. C
  286. ZERO=0.D0
  287. CALL CREPO1(ZERO,ZERO,ZERO,IPOIN)
  288. NBSOUS=0
  289. NBREF=0
  290. NBNN=1
  291. NBELEM=1
  292. SEGINI MELEME
  293. NUM(1,1)=IPOIN
  294. ITYPEL=1
  295. SEGDES MELEME
  296. MSOLIS(3)=MELEME
  297. C
  298. N=1
  299. DO 1100 I=4,NIPO
  300. IF(MSOLIS(I).EQ.0)GOTO 1100
  301. SEGINI MSOLEN
  302. ISOLEN(1)=MSOLIS(I)
  303. SEGDES MSOLEN
  304. MSOLIS(I)=MSOLEN
  305. GOTO (1100,1100,1100,1100,1101,1102,1102,1101,1101,1100),I
  306. 1101 CONTINUE
  307. MSOLIT(I)=2
  308. GOTO1100
  309. 1102 CONTINUE
  310. MSOLIT(I)=5
  311. 1100 CONTINUE
  312. SEGDES MSOLUT
  313. C
  314. IF(IIM.EQ.1) THEN
  315. MSOL1=MSOLUT
  316. ELSE
  317. CALL FUSOLU(MSOL1,MSOLUT,MSOL2)
  318. MSOL1=MSOL2
  319. ENDIF
  320. 30 CONTINUE
  321. CALL ECROBJ('SOLUTION',MSOL1)
  322. RETURN
  323. END
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  

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