Télécharger rimb.eso

Retour à la liste

Numérotation des lignes :

  1. C RIMB SOURCE PV 16/11/17 22:01:27 9180
  2. C RIMA SOURCE ANNE 99/12/22 21:35:54 3744
  3. subroutine rimb(MYRIG)
  4.  
  5. ********************************************
  6. * traduction objet rigi en matrik
  7. * ou matrik en rigi
  8. *
  9. *******************************************
  10.  
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. POINTEUR MYMEL.MELEME
  17. -INC SMRIGID
  18. POINTEUR MYRIG.MRIGID
  19. POINTEUR MDESCR.DESCR
  20. POINTEUR MIMAT.xMATRI
  21. * POINTEUR MXMAT.XMATRI
  22. -INC SMLENTI
  23. POINTEUR KRINCP.MLENTI
  24. POINTEUR KRINCD.MLENTI
  25. -INC SMLMOTS
  26. POINTEUR LIPTOT.MLMOTS
  27. POINTEUR LIDTOT.MLMOTS
  28. *INC SMMATRIK
  29.  
  30. SEGMENT MATRIK
  31. REAL*8 COEMTK(NMATRI)
  32. INTEGER jRIGEL(NRIGE,NMATRI)
  33. INTEGER KSYM,KMINC,KMINCP,KMINCD,KIZM
  34. INTEGER KISPGT,KISPGP,KISPGD
  35. INTEGER KNTTT,KNTTP,KNTTD
  36. INTEGER KIDMAT(NKID)
  37. INTEGER KKMMT(NKMT)
  38. ENDSEGMENT
  39. POINTEUR MYMTK.MATRIK
  40.  
  41. SEGMENT jMATRI
  42. CHARACTER*8 LISPRj(NBME),LISDUb(NBME)
  43. INTEGER LIZAFM(NBSOUS,NBME)
  44. INTEGER KSPGP,KSPGD
  45. ENDSEGMENT
  46. POINTEUR MJMAT.JMATRI
  47. C Stokage matrices elementaires non assemblees (valeurs)
  48. SEGMENT IZAFM
  49. REAL*8 AM(NBEL,NP,MP)
  50. ENDSEGMENT
  51. POINTEUR MIZAFM.IZAFM
  52. C
  53. SEGMENT GMEL
  54. POINTEUR MELS(NMEL).MELEME
  55. ENDSEGMENT
  56. POINTEUR LMLPRI.GMEL
  57. POINTEUR LMLDUA.GMEL
  58. POINTEUR LMELP.GMEL
  59. POINTEUR LMELD.GMEL
  60. POINTEUR MYMELP.MELEME
  61. POINTEUR MYMELD.MELEME
  62.  
  63. SEGMENT GJMAT
  64. POINTEUR JMATS(NJMAT).JMATRI
  65. ENDSEGMENT
  66. POINTEUR LJMAT.GJMAT
  67. SEGMENT GIZA
  68. POINTEUR IZAS(NIZA).IZAFM
  69. ENDSEGMENT
  70. POINTEUR LIZA.GIZA
  71. POINTEUR MIZA.IZAFM
  72. C
  73. SEGMENT GLENT
  74. POINTEUR LENTS(NLENT).MLENTI
  75. ENDSEGMENT
  76. POINTEUR LLEPRI.GLENT
  77. POINTEUR LLEDUA.GLENT
  78. POINTEUR LKRPRI.GLENT
  79. POINTEUR LKRDUA.GLENT
  80. POINTEUR MYLNTP.MLENTI
  81. POINTEUR MYLNTD.MLENTI
  82. POINTEUR MYKRP.MLENTI
  83. POINTEUR MYKRD.MLENTI
  84. *
  85. * Déclaration des variables
  86. *
  87. INTEGER NRIG,NRIGEL,NBME,NNOEL,NP,MP
  88. INTEGER KRIGEL,IBME, IP,ID,IP2,ID2
  89. INTEGER NLIGRP,NLIGRD
  90. INTEGER ILIGRP,ILIGRD
  91. INTEGER NPUNIQ,NDUNIQ,NBEL,NBNN
  92. INTEGER IPUNIQ,IDUNIQ,IBEL,IBNN,IEL,IELRIG
  93. INTEGER NPOPQ,NPODQ
  94. REAL*8 COEF,VAL
  95.  
  96. CHARACTER*8 TYPE,TYPP
  97.  
  98. *
  99. * Passage Rigidité en MATRIK
  100. *
  101. * write(6,*) ' entree dans rimb nrig',nrig
  102. IMPR=0
  103. SEGACT MYRIG
  104. NRIG =MYRIG.IRIGEL(/1)
  105. NRIGEL=MYRIG.IRIGEL(/2)
  106. * Un tests pour voir si on peut faire la conversion
  107. IF (NRIG.EQ.6) THEN
  108. * WRITE(IOIMP,*) 'NRIGE.EQ.6, check the output matrix'
  109. ENDIF
  110. IMATRI=0
  111. * Calcule de maniere a limiter le nombre de SEGADJ dans la boucle
  112. INCNMA=MAX(1000,NRIGEL*3)
  113. NMATRI=INCNMA
  114. NRIGE = 7
  115. NKID=9
  116. NKMT=7
  117. SEGINI MYMTK
  118. *
  119. DO 1 KRIGEL=1,NRIGEL
  120. * D'autres tests pour voir si on peut faire la conversion
  121. IF(MYRIG.IRIGEL(5,KRIGEL).NE.0) THEN
  122. WRITE(IOIMP,*) 'Harmonique de fourier non nulle'
  123. * 19 2
  124. *Option indisponible
  125. CALL ERREUR(19)
  126. ENDIF
  127. IF(MYRIG.IRIGEL(6,KRIGEL).NE.0) THEN
  128. WRITE(IOIMP,*) 'Matrice definie par une inegalite'
  129. CALL ERREUR(19)
  130. ENDIF
  131. COEF =MYRIG.COERIG(KRIGEL)
  132. MYMEL =MYRIG.IRIGEL(1,KRIGEL)
  133. SEGACT MYMEL
  134. NNOEL = MYMEL.NUM(/1)
  135. NEL = MYMEL.NUM(/2)
  136. *** MYMTK.JRIGEL(1,KRIGEL)=MYMEL
  137. *** MYMTK.JRIGEL(2,KRIGEL)=MYMEL
  138. * Analyse du segment descripteur
  139. MDESCR=MYRIG.IRIGEL(3,KRIGEL)
  140. SEGACT MDESCR
  141. NLIGRP=MDESCR.NOELEP(/1)
  142. NLIGRD=MDESCR.NOELED(/1)
  143. * Construction de la liste d'inconnues primales sans doublons
  144. * et du segment de repérage dans cette liste
  145. JGN=4
  146. JGM=NLIGRP
  147. SEGINI LIPTOT
  148. CALL CUNIQ(MDESCR.LISINC,4,NLIGRP,
  149. $ LIPTOT.MOTS,NPUNIQ,
  150. $ IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. JGN=4
  153. JGM=NPUNIQ
  154. SEGADJ,LIPTOT
  155. JG=NLIGRP
  156. SEGINI KRINCP
  157. CALL CREPER(4,NLIGRP,NPUNIQ,MDESCR.LISINC,LIPTOT.MOTS,
  158. $ KRINCP.LECT,
  159. $ IMPR,IRET)
  160. IF (IRET.NE.0) GOTO 9999
  161. * Construction de la liste d'inconnues duales sans doublons
  162. * et du segment de repérage dans cette liste
  163. JGN=4
  164. JGM=NLIGRD
  165. SEGINI LIDTOT
  166. CALL CUNIQ(MDESCR.LISDUA,4,NLIGRD,
  167. $ LIDTOT.MOTS,NDUNIQ,
  168. $ IMPR,IRET)
  169. IF (IRET.NE.0) GOTO 9999
  170. JGN=4
  171. JGM=NDUNIQ
  172. SEGADJ,LIDTOT
  173. JG=NLIGRD
  174. SEGINI KRINCD
  175. CALL CREPER(4,NLIGRD,NDUNIQ,MDESCR.LISDUA,LIDTOT.MOTS,
  176. $ KRINCD.LECT,
  177. $ IMPR,IRET)
  178. IF (IRET.NE.0) GOTO 9999
  179. * Pour chaque inconnue PRIMALE, construction de la liste des noeuds
  180. * (locaux par élément) sur lequel il porte
  181. NLENT=NPUNIQ
  182. SEGINI,LLEPRI
  183. JG=0
  184. SEGINI,LLEPRI.LENTS(*)
  185. DO ILIGRP=1,NLIGRP
  186. IPUNIQ=KRINCP.LECT(ILIGRP)
  187. MYLNTP=LLEPRI.LENTS(IPUNIQ)
  188. MYLNTP.LECT(**)=MDESCR.NOELEP(ILIGRP)
  189. ENDDO
  190. * Suppression des doublons éventuels
  191. DO IPUNIQ=1,NPUNIQ
  192. CALL IUNIQ(LLEPRI.LENTS(IPUNIQ).LECT,
  193. $ LLEPRI.LENTS(IPUNIQ).LECT(/1),
  194. $ LLEPRI.LENTS(IPUNIQ).LECT,NPOPQ,
  195. $ IMPR,IRET)
  196. IF (IRET.NE.0) GOTO 9999
  197. JG=NPOPQ
  198. SEGADJ,LLEPRI.LENTS(IPUNIQ)
  199. ENDDO
  200. * segment de repérage dans cette liste
  201. NLENT=NPUNIQ
  202. SEGINI,LKRPRI
  203. JG=NNOEL
  204. SEGINI,LKRPRI.LENTS(*)
  205. DO IPUNIQ=1,NPUNIQ
  206. CALL RSETXI(LKRPRI.LENTS(IPUNIQ).LECT,
  207. $ LLEPRI.LENTS(IPUNIQ).LECT,
  208. $ LLEPRI.LENTS(IPUNIQ).LECT(/1))
  209. ENDDO
  210. * Pour chaque inconnue DUALE, construction de la liste des noeuds
  211. * (locaux par élément) sur lequel il porte
  212. NLENT=NDUNIQ
  213. SEGINI,LLEDUA
  214. JG=0
  215. SEGINI,LLEDUA.LENTS(*)
  216. DO ILIGRD=1,NLIGRD
  217. IDUNIQ=KRINCD.LECT(ILIGRD)
  218. MYLNTD=LLEDUA.LENTS(IDUNIQ)
  219. MYLNTD.LECT(**)=MDESCR.NOELED(ILIGRD)
  220. ENDDO
  221. * Suppression des doublons éventuels
  222. DO IDUNIQ=1,NDUNIQ
  223. CALL IUNIQ(LLEDUA.LENTS(IDUNIQ).LECT,
  224. $ LLEDUA.LENTS(IDUNIQ).LECT(/1),
  225. $ LLEDUA.LENTS(IDUNIQ).LECT,NPODQ,
  226. $ IMPR,IRET)
  227. IF (IRET.NE.0) GOTO 9999
  228. JG=NPODQ
  229. SEGADJ,LLEDUA.LENTS(IDUNIQ)
  230. ENDDO
  231. * segment de repérage dans cette liste
  232. NLENT=NDUNIQ
  233. SEGINI,LKRDUA
  234. JG=NNOEL
  235. SEGINI,LKRDUA.LENTS(*)
  236. DO IDUNIQ=1,NDUNIQ
  237. CALL RSETXI(LKRDUA.LENTS(IDUNIQ).LECT,
  238. $ LLEDUA.LENTS(IDUNIQ).LECT,
  239. $ LLEDUA.LENTS(IDUNIQ).LECT(/1))
  240. ENDDO
  241. * Pour chaque inconnue PRIMALE, construction de l'objet géométrie
  242. NMEL=NPUNIQ
  243. SEGINI,LMLPRI
  244. DO IPUNIQ=1,NPUNIQ
  245. NBNN=LLEPRI.LENTS(IPUNIQ).LECT(/1)
  246. NBELEM=NEL
  247. NBSOUS=0
  248. NBREF=0
  249. SEGINI,LMLPRI.MELS(IPUNIQ)
  250. DO IEL=1,NEL
  251. DO IBNN=1,NBNN
  252. MYMELP=LMLPRI.MELS(IPUNIQ)
  253. MYLNTP=LLEPRI.LENTS(IPUNIQ)
  254. MYMELP.NUM(IBNN,IEL)=
  255. $ MYMEL.NUM(MYLNTP.LECT(IBNN),IEL)
  256. ENDDO
  257. ENDDO
  258. SEGDES,LMLPRI.MELS(IPUNIQ)
  259. ENDDO
  260. * Pour chaque inconnue DUALE, construction de l'objet géométrie
  261. NMEL=NDUNIQ
  262. SEGINI,LMLDUA
  263. DO IDUNIQ=1,NDUNIQ
  264. NBNN=LLEDUA.LENTS(IDUNIQ).LECT(/1)
  265. NBELEM=NEL
  266. NBSOUS=0
  267. NBREF=0
  268. SEGINI,LMLDUA.MELS(IDUNIQ)
  269. DO IEL=1,NEL
  270. DO IBNN=1,NBNN
  271. MYMELD=LMLDUA.MELS(IDUNIQ)
  272. MYLNTD=LLEDUA.LENTS(IDUNIQ)
  273. MYMELD.NUM(IBNN,IEL)=
  274. $ MYMEL.NUM(MYLNTD.LECT(IBNN),IEL)
  275. ENDDO
  276. ENDDO
  277. SEGDES,LMLDUA.MELS(IDUNIQ)
  278. ENDDO
  279. *
  280. * Initialisation des objets que l'on concatènera dans MATRIK
  281. *
  282. NMAT=NPUNIQ*NDUNIQ
  283. NMEL=NMAT
  284. SEGINI,LMELP
  285. SEGINI,LMELD
  286. NJMAT=NMAT
  287. SEGINI,LJMAT
  288. NBME=1
  289. NBSOUS=1
  290. SEGINI,LJMAT.JMATS(*)
  291. NIZA=NMAT
  292. SEGINI,LIZA
  293. DO IPUNIQ=1,NPUNIQ
  294. DO IDUNIQ=1,NDUNIQ
  295. * Initialisation de LIZA
  296. IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
  297. NBEL=NEL
  298. NP=LLEPRI.LENTS(IPUNIQ).LECT(/1)
  299. MP=LLEDUA.LENTS(IDUNIQ).LECT(/1)
  300. SEGINI,LIZA.IZAS(IMAT)
  301. * Initialisation de LJMAT
  302. MJMAT=LJMAT.JMATS(IMAT)
  303. MJMAT.LISPRJ(1)=LIPTOT.MOTS(IPUNIQ)//' '
  304. MJMAT.LISDUB(1)=LIDTOT.MOTS(IDUNIQ)//' '
  305. MJMAT.LIZAFM(1,1)=LIZA.IZAS(IMAT)
  306. * Initialisation de LMELP et LMELD
  307. LMELP.MELS(IMAT)=LMLPRI.MELS(IPUNIQ)
  308. LMELD.MELS(IMAT)=LMLDUA.MELS(IDUNIQ)
  309. ENDDO
  310. ENDDO
  311. *
  312. * Boucle sur les matrices élémentaires de MYRIG
  313. * et recopie des valeurs dans les IZAS de LIZA
  314. *
  315. MIMAT=MYRIG.IRIGEL(4,KRIGEL)
  316. SEGACT MIMAT
  317. NELRIG=MIMAT.re(/3)
  318. DO IELRIG=1,NELRIG
  319. * MXMAT=MIMAT.IMATTT(IELRIG)
  320. * SEGACT MXMAT
  321. DO ILIGRP=1,NLIGRP
  322. IPUNIQ=KRINCP.LECT(ILIGRP)
  323. IP=MDESCR.NOELEP(ILIGRP)
  324. MYKRP=LKRPRI.LENTS(IPUNIQ)
  325. DO ILIGRD=1,NLIGRD
  326. IDUNIQ=KRINCD.LECT(ILIGRD)
  327. ID=MDESCR.NOELED(ILIGRD)
  328. MYKRD=LKRDUA.LENTS(IDUNIQ)
  329. IMAT=(IPUNIQ-1)*NDUNIQ+IDUNIQ
  330. MIZA=LIZA.IZAS(IMAT)
  331. IBEL=IELRIG
  332. IP2=MYKRP.LECT(IP)
  333. ID2=MYKRD.LECT(ID)
  334. VAL=MIMAT.RE(ILIGRD,ILIGRP,ielrig)
  335. MIZA.AM(IBEL,IP2,ID2)=VAL*COEF
  336. ENDDO
  337. ENDDO
  338. * SEGDES MXMAT
  339. ENDDO
  340. SEGDES MIMAT
  341. SEGDES,LIZA.IZAS(*)
  342. SEGSUP,LIZA
  343. SEGDES,LJMAT.JMATS(*)
  344. *
  345. * Concaténation des valeurs dans l'objet MATRIK
  346. *
  347. NMATAV=IMATRI
  348. * NMATAP=IMATRI+NMAT
  349. IMATRI=IMATRI+NMAT
  350. IF (IMATRI.GT.NMATRI) THEN
  351. NMATRI=IMATRI+INCNMA
  352. NRIGE = 7
  353. NKID=9
  354. NKMT=7
  355. SEGADJ,MYMTK
  356. ENDIF
  357. DO IMAT=1,NMAT
  358. MYMTK.JRIGEL(1,NMATAV+IMAT)=LMELP.MELS(IMAT)
  359. MYMTK.JRIGEL(2,NMATAV+IMAT)=LMELD.MELS(IMAT)
  360. MYMTK.JRIGEL(4,NMATAV+IMAT)=LJMAT.JMATS(IMAT)
  361. MYMTK.JRIGEL(7,NMATAV+IMAT)=3
  362. ENDDO
  363. SEGSUP,LJMAT
  364. SEGSUP,LMELD
  365. SEGSUP,LMELP
  366. SEGSUP,LMLDUA
  367. SEGSUP,LMLPRI
  368. SEGSUP,LKRDUA.LENTS(*)
  369. SEGSUP,LKRDUA
  370. SEGSUP,LLEDUA.LENTS(*)
  371. SEGSUP,LLEDUA
  372. SEGSUP,LKRPRI.LENTS(*)
  373. SEGSUP,LKRPRI
  374. SEGSUP,LLEPRI.LENTS(*)
  375. SEGSUP,LLEPRI
  376. SEGSUP KRINCP
  377. SEGSUP LIDTOT
  378. SEGSUP KRINCD
  379. SEGSUP LIPTOT
  380. SEGDES MDESCR
  381. SEGDES MYMEL
  382. 1 CONTINUE
  383. NMATRI=IMATRI
  384. NRIGE = 7
  385. NKID=9
  386. NKMT=7
  387. SEGADJ,MYMTK
  388. *
  389. SEGDES MYMTK
  390. SEGDES MYRIG
  391. CALL ECROBJ('MATRIK',MYMTK)
  392. RETURN
  393. *
  394. * Error handling
  395. *
  396. 9999 CONTINUE
  397. WRITE(IOIMP,*) 'An error was detected in subroutine rima'
  398. RETURN
  399. END
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  

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