Télécharger rlexfi.eso

Retour à la liste

Numérotation des lignes :

  1. C RLEXFI SOURCE CHAT 05/01/13 03:03:03 5004
  2. SUBROUTINE RLEXFI(MLESCF,MATCOE,MLEFSC,MACOE1,MLEFC,MACOE2)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : RLEXFI
  8. C
  9. C DESCRIPTION : Appelle par GRADIA
  10. C
  11. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  12. C
  13. C AUTEUR : A. BECCANTINI
  14. C
  15. C************************************************************************
  16. C
  17. C Inputs:
  18. C
  19. C MLESCF : list of SOMMET points and their CENTRE neighbors
  20. C
  21. C MATCOE : coeff. for linear exact reconstruction of MLESCF
  22. C
  23. C MLEFSC : list of FACES points and their neighbors (CENTRE and SOMMET
  24. C points)
  25. C
  26. C MACOE1 : coeff. for linear exact reconstruction of MLEFSC
  27. C
  28. C Output
  29. C
  30. C MLEFC : list of FACES points and their neighbors (CENTRE points only)
  31. C
  32. C MACOE2 : coeff. for linear exact reconstruction of MLEFC
  33. C
  34. C
  35. C**** Variables de COOPTIO
  36. C
  37. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  38. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  39. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  40. C & ,IECHO, IIMPI, IOSPI
  41. C & ,IDIM
  42. CC & ,MCOORD
  43. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  44. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  45. C & ,NORINC,NORVAL,NORIND,NORVAD
  46. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  47. C
  48. IMPLICIT INTEGER(I-N)
  49. -INC CCOPTIO
  50. -INC SMCOORD
  51. INTEGER JG
  52. -INC SMLENTI
  53. POINTEUR MLECEN.MLENTI, MLESOM.MLENTI, MCLEAR.MLENTI
  54. -INC SMLREEL
  55. POINTEUR MLRCOE.MLREEL
  56. C
  57. INTEGER NBL, NBTPOI
  58. SEGMENT MLELEM
  59. INTEGER INDEX(NBL+1)
  60. INTEGER LESPOI(NBTPOI)
  61. ENDSEGMENT
  62. POINTEUR MLESCF.MLELEM,MLEFSC.MLELEM, MLEFC.MLELEM
  63. C
  64. INTEGER N1,N2
  65. SEGMENT MATRIX
  66. REAL*8 MAT(N1,N2)
  67. ENDSEGMENT
  68. POINTEUR MATCOE.MATRIX, MACOE1.MATRIX, MACOE2.MATRIX
  69. C
  70. INTEGER NSOM, IPOS, IPOS1, NMAXVS, IELEM, NFAC, NGS, NMAXVF, I1
  71. & , NGF, IPOSF, NVOIF, NCEN, NGP, NLS, IPOSP, IPOSP1
  72. & , NVOI, I2 , IPOSV, NGC, NLC
  73. REAL*8 ERRO, VAL
  74. C
  75. C**** MLESCF = MLELEM sommet-centres voisins
  76. C NMAXVS = nombre max de voisins aux sommets
  77. C
  78. SEGACT MLESCF
  79. NSOM=MLESCF.INDEX(/1)-1
  80. IPOS1=MLESCF.INDEX(1)
  81. C
  82. C**** N.B. Le sommet n'a pas de voisins si il
  83. C appartient aux CL
  84. C
  85. NMAXVS=1
  86. DO IELEM = 1, NSOM, 1
  87. IPOS=IPOS1
  88. IPOS1=MLESCF.INDEX(1+IELEM)
  89. NMAXVS=MAX(NMAXVS,(IPOS1-IPOS-1))
  90. ENDDO
  91. C
  92. C**** MLEFSC = MLELEM face (sommets-centres) voisins
  93. C NMAXVF = nombre max de voisins sommets aux faces
  94. C (N.B: dedans MLEFSC, un/deux points sont des points centres)
  95. C
  96. SEGACT MLEFSC
  97. NFAC=MLEFSC.INDEX(/1)-1
  98. IPOS1=MLEFSC.INDEX(1)
  99. NMAXVF=0
  100. DO IELEM = 1, NSOM, 1
  101. IPOS=IPOS1
  102. IPOS1=MLEFSC.INDEX(1+IELEM)
  103. NMAXVF=MAX(NMAXVF,(IPOS1-IPOS-1))
  104. ENDDO
  105. C
  106. NBL=NFAC
  107. NBTPOI=NFAC*(NMAXVS*NMAXVF)+NFAC
  108. C
  109. C**** NBTPOI iper sur-dimensionné
  110. C
  111. SEGINI MLEFC
  112. N1=IDIM
  113. N2=NBTPOI
  114. SEGINI MACOE2
  115. C
  116. C
  117. C**** MLECEN.MLENTI = position du centre NGC dedans un elt
  118. C face -centres
  119. C
  120. C MCLEAR = liste des points centres (pour nettoyer MLECEN)
  121. C
  122. C
  123. C MLESOM = position du sommet dedans MLESCF
  124. C
  125. JG=MCOORD.XCOOR(/1)/(IDIM+1)
  126. SEGINI MLECEN
  127. SEGINI MLESOM
  128. C
  129. DO IELEM=1,NSOM,1
  130. IPOS=MLESCF.INDEX(IELEM)
  131. NGS=MLESCF.LESPOI(IPOS)
  132. MLESOM.LECT(NGS)=IELEM
  133. ENDDO
  134. C
  135. JG=NMAXVS*NMAXVF
  136. SEGINI MCLEAR
  137. C
  138. C**** On crée MLRCOE:
  139. C
  140. C IPOS = MLESCF.INDEX(NLS)
  141. C IPOS1 = MLESCF.INDEX(NLS+1)
  142. C NGS = MLESCF.LESPOI(IPOS)
  143. C
  144. C
  145. C**** N.B. If MATCOE is expressed in the absolute frame
  146. C
  147. C VAL_NGS = \sum_{J=IPOS+1,IPOS1-1) (MATCOE.MAT(1,J) +
  148. C MATCOE.MAT(2,J) * X_NGS + MATCOE.MAT(3,J) * YNGS)
  149. C * VAL_J
  150. C
  151. C MLRCOE.PROG(J) = (MATCOE.MAT(1,J) +
  152. C MATCOE.MAT(2,J) * X_NGS + MATCOE.MAT(3,J) * YNGS)
  153. C
  154. C If MATCOE is expressed in the relative frame
  155. C
  156. C MLRCOE.PROG(J) = MATCOE.MAT(1,J)
  157. C
  158. SEGACT MATCOE
  159. N2=MATCOE.MAT(/2)
  160. NBTPOI=MLESCF.LESPOI(/1)
  161. IF(N2 .NE. NBTPOI)THEN
  162. WRITE(IOIMP,*) 'Subroutine rlexfi.eso'
  163. CALL ERREUR(5)
  164. GOTO 9999
  165. ENDIF
  166. C
  167. JG=N2
  168. SEGINI MLRCOE
  169. IPOS1=MLESCF.INDEX(1)
  170. DO IELEM=1,NSOM,1
  171. IPOS=IPOS1
  172. IPOS1=MLESCF.INDEX(1+IELEM)
  173. NGS=MLESCF.LESPOI(IPOS)
  174. MLRCOE.PROG(IPOS)=MATCOE.MAT(1,IPOS)
  175. C
  176. C******* N.B. IPOS+1 peut etre plus grand que IPOS1-1
  177. C En ce cas, pas de boucle
  178. C
  179. DO I1 = (IPOS+1),(IPOS1-1),1
  180. MLRCOE.PROG(I1)=MATCOE.MAT(1,I1)
  181. ENDDO
  182. ENDDO
  183. C
  184. C**** On detrui MATCOE
  185. C On rempli MACOE2.MAT
  186. C MLEFC.MELEME : face - (voisins de type centre
  187. C + sommets appartenant
  188. C aux c.l.)
  189. C
  190. SEGSUP MATCOE
  191. SEGACT MACOE1
  192. C
  193. IPOS1=MLEFSC.INDEX(1)
  194. IPOSF=1
  195. MLEFC.INDEX(1)=IPOSF
  196. DO IELEM=1,NFAC,1
  197. IPOS=IPOS1
  198. IPOS1=MLEFSC.INDEX(1+IELEM)
  199. NGF=MLEFSC.LESPOI(IPOS)
  200. IPOSF=MLEFC.INDEX(IELEM)
  201. MLEFC.LESPOI(IPOSF)=NGF
  202. C
  203. C******* NGF a de voisins en MLEFSC.MLELEM:
  204. C a) de type centre (un ou deux)
  205. C b) de type sommet
  206. C
  207. NVOIF=0
  208. NCEN=0
  209. C
  210. C******* NVOIF = nombre de voisins de NGF dedans
  211. C MLEFC.MLELEM
  212. C NCEN = nombre de voisins de type CENTRE de NGF dedans
  213. C MLEFC.MLELEM
  214. C
  215. C
  216. C******* Boucle sur le voisins de NGF en MLEFSC.MLELEM
  217. C
  218. DO I1=(IPOS+1),(IPOS1-1),1
  219. NGP=MLEFSC.LESPOI(I1)
  220. NLS=MLESOM.LECT(NGP)
  221. C
  222. C********** Deux possibilité:
  223. C NLS > 0 -> NGP est un point sommet
  224. C Dans ce cas NLS=position de NGP
  225. C dedans MLESCF.MLELEM
  226. C NLS = 0 -> NGP est un point centre
  227. C
  228. IF(NLS.GT.0)THEN
  229. IPOSP=MLESCF.INDEX(NLS)
  230. IPOSP1=MLESCF.INDEX(NLS+1)
  231. NVOI=IPOSP1-IPOSP-1
  232. IF(NVOI.EQ.0)THEN
  233. C
  234. C**************** Le point sommet NGP n'a pas de voisins
  235. C Donc il appartient aux c.l.
  236. C
  237. C Sa position dedans MLEFSC est I1
  238. C Sa position dedans MLESCF est IPOSP
  239. C
  240. ERRO=ABS(MLRCOE.PROG(IPOSP) - 1.0D0)
  241. IF(ERRO .GT. 1.0D-6)THEN
  242. WRITE(IOIMP,*) 'Subroutine rlexfi.eso'
  243. CALL ERREUR(5)
  244. GOTO 9999
  245. ENDIF
  246. NVOIF=NVOIF+1
  247. IPOSV=IPOSF+NVOIF
  248. MLEFC.LESPOI(IPOSV)=NGP
  249. MACOE2.MAT(1,IPOSV)=MACOE1.MAT(2,I1)
  250. MACOE2.MAT(2,IPOSV)=MACOE1.MAT(3,I1)
  251. IF(IDIM.EQ.3) MACOE2.MAT(3,IPOSV)=
  252. & MACOE1.MAT(4,I1)
  253. ELSEIF(NVOI.GT.0)THEN
  254. C
  255. C**************** Boucle sur les voisins du point sommet NGP
  256. C dedans MLESCF.MLELEM
  257. C
  258. DO I2 = (IPOSP+1),(IPOSP1-1),1
  259. VAL=MLRCOE.PROG(I2)
  260. NGC=MLESCF.LESPOI(I2)
  261. NLC=MLECEN.LECT(NGC)
  262. C
  263. C******************* NLC = position de NGC dans la structure
  264. C NGF - se voisins en MLEFC.MLELEM
  265. C
  266. IF(NLC .EQ. 0)THEN
  267. C
  268. C********************** Nouveau voisin centre
  269. C
  270. NVOIF=NVOIF+1
  271. NCEN=NCEN+1
  272. MCLEAR.LECT(NCEN)=NGC
  273. MLECEN.LECT(NGC)=NVOIF
  274. IPOSV=IPOSF+NVOIF
  275. MLEFC.LESPOI(IPOSV)=NGC
  276. ELSE
  277. IPOSV=IPOSF+NLC
  278. ENDIF
  279. C
  280. C******************* I1 est la position du point sommet NGP dedans
  281. C MLEFSC.MLELEM, i.e.
  282. C MLEFSC.LESPOI(I1)=NGP
  283. C
  284. MACOE2.MAT(1,IPOSV)=MACOE2.MAT(1,IPOSV)+
  285. & (MACOE1.MAT(2,I1)*VAL)
  286. MACOE2.MAT(2,IPOSV)=MACOE2.MAT(2,IPOSV)+
  287. & (MACOE1.MAT(3,I1)*VAL)
  288. IF(IDIM.EQ.3) MACOE2.MAT(3,IPOSV)=
  289. & MACOE2.MAT(3,IPOSV)+
  290. & (MACOE1.MAT(4,I1)*VAL)
  291. ENDDO
  292. ELSEIF(NVOI.LT.0)THEN
  293. WRITE(IOIMP,*) 'Subroutine rlexfi.eso'
  294. CALL ERREUR(5)
  295. GOTO 9999
  296. ENDIF
  297. C
  298. ELSEIF(NLS.EQ.0)THEN
  299. C
  300. C************* NGP est un point centre
  301. C I1 = position de NGP dedans MLEFSC
  302. C i.e. MLEFSC.LESPOI(I1)=NGP
  303. C
  304. NLC=MLECEN.LECT(NGP)
  305. IF(NLC .EQ. 0)THEN
  306. C
  307. C******************* Nouveau point centre
  308. C
  309. NVOIF=NVOIF+1
  310. NCEN=NCEN+1
  311. MCLEAR.LECT(NCEN)=NGP
  312. MLECEN.LECT(NGP)=NVOIF
  313. IPOSV=IPOSF+NVOIF
  314. MLEFC.LESPOI(IPOSV)=NGP
  315. ELSE
  316. IPOSV=IPOSF+NLC
  317. ENDIF
  318. MACOE2.MAT(1,IPOSV)=MACOE2.MAT(1,IPOSV)+
  319. & MACOE1.MAT(2,I1)
  320. MACOE2.MAT(2,IPOSV)=MACOE2.MAT(2,IPOSV)+
  321. & MACOE1.MAT(3,I1)
  322. IF(IDIM.EQ.3) MACOE2.MAT(3,IPOSV)=
  323. & MACOE2.MAT(3,IPOSV)+
  324. & MACOE1.MAT(4,I1)
  325. ELSEIF(NLS.LT.0)THEN
  326. WRITE(IOIMP,*) 'Subroutine rlexfi.eso'
  327. CALL ERREUR(5)
  328. GOTO 9999
  329. ENDIF
  330. C
  331. C******* Fin boucle sur le voisins de NGF en MLEFSC.MLELEM
  332. C
  333. ENDDO
  334. C
  335. MLEFC.INDEX(IELEM+1)=IPOSF+NVOIF+1
  336. C
  337. C******* Nettoyage de MCLEAR et MLECEN
  338. C
  339. DO I1 = 1, NCEN , 1
  340. NGC=MCLEAR.LECT(I1)
  341. MLECEN.LECT(NGC)=0
  342. MCLEAR.LECT(I1)=0
  343. ENDDO
  344. C
  345. ENDDO
  346. NBTPOI=MLEFC.INDEX(NFAC+1)-1
  347. N2 = NBTPOI
  348. C
  349. SEGADJ MLEFC
  350. SEGADJ MACOE2
  351. SEGDES MLEFC
  352. SEGDES MACOE2
  353. C
  354. C**** On detrui tous les objet qui ne servent plus
  355. C
  356. SEGSUP MLEFSC
  357. SEGSUP MLESCF
  358. SEGSUP MATCOE
  359. SEGSUP MLRCOE
  360. SEGSUP MLESOM
  361. SEGSUP MLECEN
  362. SEGSUP MCLEAR
  363. C
  364. 9999 RETURN
  365. END
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  

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