Télécharger elfcha.eso

Retour à la liste

Numérotation des lignes :

  1. C ELFCHA SOURCE BP208322 15/06/22 21:17:38 8543
  2. SUBROUTINE ELFCHA(MCHARG,KOMALI,KNREFE,KACHAR)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C =====================================================================
  7. C
  8. C CREATION DU SEGMENT MACHAR A PARTIR DE L'OBJET CHARGEMENT MCHARG
  9. C
  10. C SOUS PROGRAMME APPELE PAR ELFE
  11. C
  12. C KNREFE : SEGMENT QUI DECRIT LES ELEMENTS
  13. C KOMALI : SEGMENT DE POINTEURS SUR LES SEGMENTS MALIAI DEFINISSANT
  14. C LES LIAISONS
  15. C
  16. C GUILBAUD MAI 86
  17. C
  18. C =====================================================================
  19. C
  20. -INC CCOPTIO
  21. -INC CCHAMP
  22. -INC SMCHARG
  23. -INC SMCHPOI
  24. -INC SMELEME
  25. -INC SMLREEL
  26. C
  27. SEGMENT MALIAI
  28. REAL*8 ALIA1(NALI)
  29. REAL*8 ALIA2(NBLI)
  30. REAL*8 ALIA3(NL/2,NL/2)
  31. REAL*8 ALIA4(NL/2,NL/2)
  32. REAL*8 BLIAI(NL)
  33. REAL*8 XLIAI(NL)
  34. INTEGER NLBLI(2,NBSTLI)
  35. INTEGER NDCLIA(NL)
  36. INTEGER NVNLIA(NL/2)
  37. INTEGER IBCHA(NCHAL)
  38. POINTEUR KWLIAI.MWLIAI
  39. POINTEUR KLIMAS.MLIMAS
  40. ENDSEGMENT
  41. C
  42. C MATRICE DE LIAISON PUIS SON INVERSE EN 4 BLOCS:
  43. C ALIA1 : MATRICE BANDE I-A0
  44. C -1
  45. C ALIA2 : MATRICE BANDE -B0
  46. C ALIA3 : MATRICE DE LIAISON TERMES EN DEPLACEMENT
  47. C ALIA4 : MATRICE DE LIAISON TERMES EN CONTRAINTE
  48. C NLBLI : TABLEAU DE CORRESPONDANCE ENTRE LES BLOCS
  49. C BLIAI : VECTEUR SECOND MEMBRE -> VN ET CHARGEMENT EVENTUEL
  50. C XLIAI : VECTEUR PREMIER MEMBRE -> DNCN
  51. C NDCLIA(NJC)=IKID : LA NJC-IEME INCONNUE DE XLIAI EST LE IKID-IEME
  52. C DDL DE DNCN
  53. C DNCN(IKID) <- XLIAI(NJC)
  54. C NVNLIA(NJL)=IKIV : LA NJL-IEME INCONNUE DE BLIAI EST LE IKIV-IEME
  55. C DDL DE VN
  56. C BLIAI(NJL) <- VN(IKIV)
  57. C NCHAL : NOMBRE DE SOUS-CHARGEMENTS AGISSANT SUR LA LIAISON
  58. C IBCHA(I)=K : LA PARTIE CHARGEMENT DE BLIAI POUR LE I-IEME SOUS-
  59. C CHARGEMENT SE TROUVE A PARTIR DE LA K+1-IEME PLACE DANS BCHAR2
  60. C BLIAI(NL/2+NJL) <- BCHAR2(K+NJL)
  61. C
  62. SEGMENT MWLIAI
  63. REAL*8 ALIAI(NL/2,NL)
  64. ENDSEGMENT
  65. C
  66. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  67. C
  68. C IKID=ICPR(NUM(I,J))+K
  69. C LA COMPOSANTE NOMD(K) DU POINT NUM EST LE IKID-IEME DDL DE DNCN
  70. C
  71. SEGMENT MACHAR
  72. INTEGER LACHAL(NCHAR)
  73. POINTEUR LACHAT(NCHAR).ICHPO2
  74. POINTEUR LACHAF(NCHAR).ICHPO3
  75. REAL*8 BCHAR1(NV1)
  76. REAL*8 BCHAR2(NV1)
  77. ENDSEGMENT
  78. C
  79. C LACHAL(I) : NOMBRE DE TERMES RELATIFS AU CHARGEMENT I DANS BCHAR1
  80. C LACHAT(I) : POINTEUR SUR LA LISTE DES TEMPS DU CHARGEMENT I
  81. C LACHAF(I) : POINTEUR SUR LA LISTE DES F(T) DU CHARGEMENT I
  82. C BCHAR1 : VECTEUR FORME PAR L'EMPILEMENT DE LA PARTIE CHARGEMENT
  83. C DES SECOND-MEMBRES BLIAI, POUR TOUTES LES LIAISONS CONCERNEES
  84. C PAR UN SOUS-CHARGEMENT ET POUR TOUS LES SOUS-CHARGEMENTS
  85. C BCHAR2 : IDEM MODULE PAR LES FONCTIONS TEMPORELLES
  86. C
  87. SEGMENT MOMALI
  88. POINTEUR NOMALI(NBLIPE).MALIAI
  89. POINTEUR KCPR2.ICPR2
  90. ENDSEGMENT
  91. C
  92. SEGMENT MNREFE
  93. INTEGER NREFE(8,NSTR)
  94. INTEGER NTANBN
  95. INTEGER NIDNCN
  96. INTEGER NTVN
  97. POINTEUR NREPA.MPASS
  98. POINTEUR NRECA.MCARA
  99. POINTEUR NRENO.MNORM
  100. POINTEUR NRECPR.ICPR
  101. POINTEUR NREMEL.MELEME
  102. POINTEUR NREDEN.MDEN
  103. ENDSEGMENT
  104. C
  105. C NSTR : NOMBRE D'ELEMENTS
  106. C NREFE(1,I) : MELEME
  107. C NREFE(2,I) : MSOSTU
  108. C NREFE(3,I) : TYPE DE L'ELEMENT
  109. C NREFE(4,I) : NOMBRE DE POINTS DU MELEME
  110. C NREFE(5,I) : NOMBRE DE DDL PAR POINT
  111. C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
  112. C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
  113. C NREFE(8,I)= 1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
  114. C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
  115. C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
  116. C NTVN : LONGUEUR DU TABLEAU VN
  117. C
  118. SEGMENT ICPR2(NIDNCN)
  119. C
  120. C NJ=ICPR2(IKID) : LE IKID-IEME DDL DE DNCN EST LE NJ-IEME DANS
  121. C L'ENSEMBLE DES XLIAI MIS BOUT-A-BOUT
  122. C
  123. SEGMENT V0(2*NTVN)*D
  124. C
  125. SEGMENT ITCOM(NC)
  126. C
  127. SEGMENT IT(NBLIPE)
  128. C
  129. SEGMENT/ITLI/(ITLIA(NCHAR,NBLIPE))
  130. C
  131. CHARACTER*4 NOC
  132. WRITE(IOIMP,*) 'DEBUT DE ELFCHA'
  133. KACHAR=0
  134. MNREFE=KNREFE
  135. ICPR=NRECPR
  136. SEGINI V0
  137. C
  138. MOMALI=KOMALI
  139. ICPR2=KCPR2
  140. NBLIPE=NOMALI(/1)
  141. SEGINI IT
  142. C
  143. SEGACT MCHARG
  144. NCHAR=KCHARG(/1)
  145. SEGINI ITLI
  146. DO 1 I=1,NBLIPE
  147. IT(I)=0
  148. DO 1 J=1,NCHAR
  149. ITLIA(J,I)=0
  150. 1 CONTINUE
  151. C
  152. NV1=NTVN
  153. SEGINI MACHAR
  154. C
  155. C BOUCLE SUR LES SOUS-CHARGEMENTS DE L'OBJET CHARGEMENT
  156. C
  157. NV1=0
  158. DO 140 I=1,NCHAR
  159. DO 10 II=1,NIDNCN
  160. V0(II)=0.D0
  161. 10 CONTINUE
  162. C
  163. C 1 - RECHERCHE DE LA POSITION DU DDL CHARGE DANS L'ENSEMBLE DES XLIAI
  164. C ET REMPLISSAGE DE V0
  165. C
  166. ICHARG=KCHARG(I)
  167. SEGACT ICHARG
  168. IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(I).NE.'STAT'
  169. & .OR.CHALIE(I).NE.'LIE ') THEN
  170. SEGDES ICHARG
  171. SEGDES MCHARG
  172. CALL ERREUR(696)
  173. RETURN
  174. ENDIF
  175. MCHPOI=ICHPO1
  176. SEGACT MCHPOI
  177. NSOUPO=IPCHP(/1)
  178. DO 70 ISOUPO=1,NSOUPO
  179. MSOUPO=IPCHP(ISOUPO)
  180. SEGACT MSOUPO
  181. MPOVAL=IPOVAL
  182. SEGACT MPOVAL
  183. NC=VPOCHA(/2)
  184. SEGINI ITCOM
  185. DO 40 INC=1,NC
  186. NOC=NOCOMP(INC)
  187. ITCOM(INC)=0
  188. DO 20 IDD=1,6
  189. IF(NOC.EQ.NOMDD(IDD)) THEN
  190. ITCOM(INC)=IDD
  191. GO TO 40
  192. ENDIF
  193. 20 CONTINUE
  194. DO 30 IDU=1,6
  195. IF(NOC.EQ.NOMDU(IDU)) THEN
  196. ITCOM(INC)=IDU+6
  197. GO TO 40
  198. ENDIF
  199. 30 CONTINUE
  200. 40 CONTINUE
  201. C
  202. MELEME=IGEOC
  203. SEGACT MELEME
  204. NBPO=NUM(/2)
  205. DO 60 IBPO=1,NBPO
  206. IKI=ICPR(NUM(1,IBPO))
  207. IF(IKI.EQ.-1) THEN
  208. C *** LE POINT NE FAIT PAS PARTIE DE LA STRUCTURE
  209. INTERR(1)=IKI
  210. CALL ERREUR(384)
  211. RETURN
  212. ENDIF
  213. DO 50 INC=1,NC
  214. IKC=ITCOM(INC)
  215. IF(IKC.EQ.0) THEN
  216. C *** LA COMPOSANTE N'EST PAS DEFINIE POUR LA STRUCTURE
  217. MOTERR(1:4)=NOCOMP(INC)
  218. CALL ERREUR(385)
  219. RETURN
  220. ENDIF
  221. VP=VPOCHA(IBPO,INC)
  222. IV=ICPR2(IKI+IKC)
  223. C WRITE(IOIMP,*) IV
  224. IF(VP.NE.0.D0) V0(IV)=VP
  225. 50 CONTINUE
  226. 60 CONTINUE
  227. SEGDES MELEME,MPOVAL,MSOUPO
  228. SEGSUP ITCOM
  229. 70 CONTINUE
  230. SEGDES MCHPOI
  231. C WRITE(IOIMP,*)(V0(J),J=1,NIDNCN)
  232. C
  233. C 2 - CREATION DU TABLEAU V1 A PARTIR DE V0
  234. C
  235. NDEPLA=0
  236. NV2=0
  237. DO 130 INLIAI=1,NBLIPE
  238. MALIAI=NOMALI(INLIAI)
  239. MWLIAI=KWLIAI
  240. NL=NDCLIA(/1)
  241. C
  242. C Y A-T-IL UN CHARGEMENT SUR LA LIAISON ?
  243. C
  244. DO 80 NJCC=1,NL
  245. IF(V0(NDEPLA+NJCC).NE.0.D0) THEN
  246. C
  247. C CREATION DE LA PARTIE CHARGEMENT DU SECOND MEMBRE BLIAI
  248. C ET EMPILEMENT DANS BCHAR1
  249. C
  250. ITT=IT(INLIAI)+1
  251. IT(INLIAI)=ITT
  252. NLS2=NL/2
  253. ITLIA(ITT,INLIAI)=NV1
  254. NVA=NV1
  255. NV1=NV1+NLS2
  256. NV2=NV2+NLS2
  257. C WRITE(IOIMP,*)ITT,NV1,NV2,INLIAI,NDEPLA
  258. DO 110 NJC=1,NL
  259. VV=V0(NDEPLA+NJC)
  260. IF(VV.NE.0.D0) THEN
  261. DO 100 NJ=1,NLS2
  262. C WRITE(IOIMP,*) ALIAI(NJL,NJC)
  263. IF(ALIAI(NJ,NJC).NE.0.D0) THEN
  264. NJA=NVA+NJ
  265. BCHAR1(NJA)=BCHAR1(NJA)+VV
  266. C WRITE(IOIMP,*) BCHAR1(NJA)
  267. ENDIF
  268. 100 CONTINUE
  269. ENDIF
  270. 110 CONTINUE
  271. GOTO 120
  272. ENDIF
  273. 80 CONTINUE
  274. 120 NDEPLA=NDEPLA+NL
  275. 130 CONTINUE
  276. C
  277. LACHAL(I)=NV2
  278. MLREEL=ICHPO2
  279. SEGACT MLREEL
  280. LACHAT(I)=ICHPO2
  281. MLREEL=ICHPO3
  282. SEGACT MLREEL
  283. LACHAF(I)=ICHPO3
  284. SEGDES ICHARG
  285. 140 CONTINUE
  286. C
  287. SEGDES MCHARG
  288. SEGSUP V0
  289. SEGADJ MACHAR
  290. KACHAR=MACHAR
  291. C
  292. C CREATION DU TABLEAU IBCHA DES SEGMENTS MALIAI
  293. C
  294. DO 160 INLIAI=1,NBLIPE
  295. MALIAI=NOMALI(INLIAI)
  296. MWLIAI=KWLIAI
  297. SEGSUP MWLIAI
  298. NCHAL=IT(INLIAI)
  299. IF(NCHAL.NE.0) THEN
  300. NL=NDCLIA(/1)
  301. NALI=ALIA1(/1)
  302. NBLI=ALIA2(/1)
  303. NBSTLI=NLBLI(/2)
  304. SEGADJ MALIAI
  305. DO 150 ITT=1,NCHAL
  306. IBCHA(ITT)=ITLIA(ITT,INLIAI)
  307. 150 CONTINUE
  308. ENDIF
  309. 160 CONTINUE
  310. SEGSUP IT,ITLI
  311. C
  312. IF(IIMPI.EQ.1) THEN
  313. DO 210 INLIAI=1,NBLIPE
  314. MALIAI=NOMALI(INLIAI)
  315. NCHAL=IBCHA(/1)
  316. WRITE(IOIMP,1001) INLIAI,NCHAL
  317. 1001 FORMAT(/1X,' LA ',I5,' IEME LIAISON EST CHARGEE AVEC ',I5,
  318. *' CHARGEMENT(S) '/)
  319. IF(NCHAL.NE.0) THEN
  320. NLS2=NDCLIA(/1)/2
  321. DO 200 J=1,NCHAL
  322. IT1=IBCHA(J)+1
  323. IT2=0
  324. DO 170 N=1,NCHAR
  325. IT2=IT2+LACHAL(N)
  326. IF(IT1.LE.IT2) THEN
  327. WRITE(IOIMP,1002) N,LACHAT(N),LACHAF(N),LACHAL(N)
  328. 1002 FORMAT(//1X,' CHARGEMENT ',I5,' T, F(T) :',I6,1X,I6,1X,I6)
  329. GOTO 180
  330. ENDIF
  331. 170 CONTINUE
  332. 180 CONTINUE
  333. IT2=IT1+NLS2-1
  334. WRITE(IOIMP,1003)(BCHAR1(IT),IT=IT1,IT2)
  335. 1003 FORMAT(1X,10(1PE12.5,1X))
  336. 200 CONTINUE
  337. ENDIF
  338. 210 CONTINUE
  339. ENDIF
  340. C
  341. WRITE(IOIMP,*) 'FIN DE ELFCHA'
  342. RETURN
  343. END
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  

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