Télécharger la plaquette Cast3M


fr en

Télécharger rlexvb.eso

Retour à la liste

Numérotation des lignes : 

rlexvb

  1. C RLEXVB    SOURCE    PV        20/03/30    21:24:21     10567          
  2.       SUBROUTINE RLEXVB(MELFL,MELFP,MELSOM,MLELEM)
  3. C
  4. C**** Variables de COOPTIO
  5. C
  6. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  7. C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  8. C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  9. C     &        ,IECHO,   IIMPI,  IOSPI
  10. C     &        ,IDIM
  11. CC     &        ,MCOORD
  12. C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  13. C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  14. C     &        ,NORINC,NORVAL,NORIND,NORVAD
  15. C     &        ,NUCROU, IPSAUV
  16. C
  17.       IMPLICIT INTEGER(I-N)
  18.       INTEGER  NSOMM, LAST, NTOTN, NTOTE, NBSOUS, NBELEM, NBNO
  19.      &       , IELEM, NGF, NGF1, INOEU, NGS1, NLS1, ISOUS
  20.      &       , IPOS1, IPOSV1, NVOIS1, INOEU2, NGS2, NLS2
  21.      &       , IVOIS, IPOS, IELEMF, I1
  22.       LOGICAL LOGCON
  23. C
  24. -INC SMCOORD
  25. -INC SMELEME
  26.       INTEGER JG
  27. -INC SMLENTI
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. C
  32.       INTEGER NBL, NBTPOI
  33.       SEGMENT MLELEM
  34.       INTEGER INDEX(NBL+1)
  35.       INTEGER LESPOI(NBTPOI)
  36.       ENDSEGMENT
  37. C
  38.       POINTEUR MELSOM.MELEME, MELFL.MELEME, MELFP.MELEME
  39.      &         ,MLESOM.MLENTI, MLEFP.MLENTI, MPOS.MLENTI, MTOUC.MLENTI
  40.      &         ,MLELE1.MLELEM, MELFP1.MELEME
  41. C
  42. C**** Le MELEME SOMMET
  43. C
  44.       CALL KRIPAD(MELSOM,MLESOM)
  45. C
  46. C     MLESOM: numerotation globale -> locale
  47. C
  48. C**** En KRIPAD
  49. C     SEGACT MELSOM
  50. C     SEGINI MLESOM
  51. C
  52.       NSOMM = MELSOM.NUM(/2)
  53.       JG=NSOMM
  54.       SEGINI MTOUC
  55. C     MTOUC.LECT(NLS1) = surestimation de nombre de voisins de NLS1
  56.       SEGINI MPOS
  57. C     MPOS.LECT + LAST : liste chaînée des sommets sur le bord
  58.       LAST=-1
  59. C
  60.       SEGACT MELFP
  61. C
  62. C**** En 2D MELFP est un maillage elementaire
  63. C     En 3D pas à priori
  64. C
  65. C     NTOTE : nombre total d'elts dans la même structure
  66. C
  67.       NTOTN = 0
  68.       NTOTE = 0
  69.       NBSOUS=MELFP.LISOUS(/1)
  70. C     NBSOUS=0 fais un peux chier!
  71.       JG=MAX(NBSOUS,1)
  72.       SEGINI MLEFP
  73.       IF(NBSOUS .EQ. 0)THEN
  74.          MLEFP.LECT(1)=MELFP
  75.       ELSE
  76.          DO ISOUS=1,NBSOUS,1
  77.             MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS)
  78.          ENDDO
  79.       ENDIF
  80.       SEGDES MELFP
  81. C
  82.       SEGACT MELFL
  83.       NBSOUS=MELFL.LISOUS(/1)
  84.       IF(NBSOUS .NE. 0)THEN
  85.          WRITE(IOIMP,*) 'FACEL = ???'
  86.          WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  87.          CALL ERREUR(5)
  88.          GOTO 9999
  89.       ENDIF
  90. C
  91.       NBSOUS=JG
  92.       IELEMF=0
  93.       DO ISOUS = 1, NBSOUS, 1
  94.          MELFP1=MLEFP.LECT(ISOUS)
  95.          SEGACT MELFP1
  96.          NBELEM=MELFP1.NUM(/2)
  97.          NBNO=MELFP1.NUM(/1) - 1
  98.          DO IELEM = 1, NBELEM,1
  99.             IELEMF=IELEMF+1
  100.             NGF=MELFP1.NUM(NBNO+1,IELEM)
  101.             NGF1=MELFL.NUM(2,IELEMF)
  102.             IF(NGF .NE. NGF1)THEN
  103.                WRITE(IOIMP,*) 'FACEL = ???'
  104.                WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  105.                CALL ERREUR(5)
  106.                GOTO 9999
  107.             ENDIF
  108.             IF(MELFL.NUM(1,IELEMF) .EQ. MELFL.NUM(3,IELEMF))THEN
  109. C
  110. C************* La face est sur le bord
  111. C
  112.                DO INOEU = 1, NBNO, 1
  113.                   NGS1 = MELFP1.NUM(INOEU,IELEM)
  114.                   NLS1 = MLESOM.LECT(NGS1)
  115.                   IF(MPOS.LECT(NLS1).EQ.0)THEN
  116.                      NTOTE=NTOTE+1
  117.                      MPOS.LECT(NLS1)=LAST
  118.                      LAST=NLS1
  119.                   ENDIF
  120.                ENDDO
  121.             ENDIF
  122.          ENDDO
  123.       ENDDO
  124. C
  125. C     NTOTN : nombre total de noeuds dans la structure sommets de bords
  126. C             + sommets voisins
  127. C     N.B. Les sommets voisins peuvent ne pas etre sur le bord
  128. C
  129.       NTOTN = 0
  130.       DO ISOUS = 1, NBSOUS, 1
  131.          MELFP1=MLEFP.LECT(ISOUS)
  132.          NBELEM=MELFP1.NUM(/2)
  133.          NBNO=MELFP1.NUM(/1) - 1
  134.          DO IELEM = 1, NBELEM,1
  135.             DO INOEU = 1, NBNO, 1
  136.                NGS1 = MELFP1.NUM(INOEU,IELEM)
  137.                NLS1 = MLESOM.LECT(NGS1)
  138.                IF(MPOS.LECT(NLS1).NE.0)THEN
  139. C
  140. C******************** Le sommet est sur le bord
  141. C
  142.                   MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+NBNO -1
  143.                   NTOTN=NTOTN+(NBNO - 1)
  144.                ENDIF
  145.             ENDDO
  146.          ENDDO
  147.       ENDDO
  148. C
  149. C**** On stoke l'informaton dans une LISTE SEQUENTIELLE INDEXEE D'ELEMENTS
  150. C
  151. C     NBL      : NOMBRE D'ELEMENTS
  152. C     NBTPOI   : NOMBRE TOTAL DE POINTS REFERENCEES
  153. C     INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT
  154. C                DANS LE TABLEAU LESPOI
  155. C     LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS
  156. C                DU IEME ELEMENT
  157. C
  158. C     En plus, après le REPEAT UNTIL,
  159. C     MPOS.LECT(NLS1) = position du sommet NLS1 i.e.
  160. C        J=MPOS.LECT(NLS1) -> NLS1=LESPOI(INDEX(J))
  161. C                            se voisins sont dedans LESPOI(INDEX(J)+1 -> INDEX(I+1)-1)
  162.       NBL=NTOTE
  163.       NBTPOI=NBL+NTOTN
  164.       SEGINI MLELEM
  165.       IPOS1=0
  166.       MLELEM.INDEX(1)=1
  167. C
  168. C**** REPEAT UNTIL
  169. C
  170.  1    CONTINUE
  171.       NLS1 = LAST
  172.       IF(NLS1 .NE. -1)THEN
  173.          IPOS1=IPOS1+1
  174.          MLELEM.LESPOI(MLELEM.INDEX(IPOS1))=NLS1
  175.          LAST = MPOS.LECT(NLS1)
  176.          MPOS.LECT(NLS1)=IPOS1
  177.          MLELEM.INDEX(IPOS1+1)=MLELEM.INDEX(IPOS1)+MTOUC.LECT(NLS1)+1
  178.          MTOUC.LECT(NLS1)=0
  179.          GOTO 1
  180.       ENDIF
  181. C
  182. C**** N.B. MTOUC.LECT(I) = 0 \forall I
  183. C
  184. C     Fin REPEAT UNTIL
  185. C     On remplie LESPOI
  186. C
  187.       DO ISOUS = 1, NBSOUS, 1
  188.          MELFP1 = MLEFP.LECT(ISOUS)
  189.          NBELEM=MELFP1.NUM(/2)
  190.          NBNO=MELFP1.NUM(/1) - 1
  191.          DO IELEM = 1, NBELEM, 1
  192.             DO INOEU = 1, NBNO, 1
  193.                NGS1 = MELFP1.NUM(INOEU,IELEM)
  194.                NLS1 = MLESOM.LECT(NGS1)
  195. C              IPOS1 = 0 -> NGS1 n'est pas sur le bords
  196. C              IPOS1 = C > 0
  197. C                C= position de NGS1 (NLS1) dedans MLELEM.INDEX
  198.                IPOS1 = MPOS.LECT(NLS1)
  199.                IF(IPOS1 .GT. 0)THEN
  200. C
  201. C                 IPOSV1 = position du premier voisin de NLS1 dedans
  202. C                       MLEMEM.LESPOI
  203.                   IPOSV1 = MLELEM.INDEX(IPOS1)+1
  204. C                 NVOIS1 = surestimation du nombre de voisins de NLS1
  205.                   NVOIS1 = MLELEM.INDEX(IPOS1+1)-IPOSV1
  206.                   DO INOEU2 = 1, NBNO, 1
  207.                      NGS2=MELFP1.NUM(INOEU2,IELEM)
  208.                      IF(NGS1 .NE. NGS2)THEN
  209.                         NLS2 = MLESOM.LECT(NGS2)
  210.                         IVOIS=0
  211. C
  212. C**************** REPEAT UNTIL
  213. C
  214.  10                     CONTINUE
  215.                         IF(MLELEM.LESPOI(IPOSV1+IVOIS) .EQ. 0)THEN
  216.                            MTOUC.LECT(NLS1)=MTOUC.LECT(NLS1)+1
  217.                            MLELEM.LESPOI(IPOSV1+IVOIS) = NLS2
  218.                         ELSE
  219.                            LOGCON = (NLS2 .NE. MLELEM.LESPOI(IPOSV1
  220.      $                          +IVOIS))
  221.                            IVOIS=IVOIS+1
  222.                            IF(LOGCON)THEN
  223.                               IF(IVOIS .GT. NVOIS1)THEN
  224. C
  225. C************************* Il y a un erreur de programmation (NVOIS1 n'a
  226. C                          pas bien été évalué)
  227. C
  228.                                  WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  229.                                  CALL ERREUR(5)
  230.                                  GOTO 9999
  231.                               ELSE
  232.                                  GOTO 10
  233.                               ENDIF
  234.                            ENDIF
  235.                         ENDIF
  236.                      ENDIF
  237.                   ENDDO
  238.                ENDIF
  239.             ENDDO
  240.          ENDDO
  241.          SEGDES MELFP1
  242.       ENDDO
  243.       SEGSUP MLEFP
  244. C
  245. C**** LESPOI SURDIMENSIONÉ
  246. C
  247.       NBTPOI=0
  248.       DO IELEM = 1 , NTOTE, 1
  249.          NLS1 = MLELEM.LESPOI(MLELEM.INDEX(IELEM))
  250.          NBTPOI=NBTPOI+1+MTOUC.LECT(NLS1)
  251.       ENDDO
  252.       NBL=NTOTE
  253.       SEGINI MLELE1
  254. C
  255.       MLELE1.INDEX(1)=1
  256.       DO IELEM = 1, NBL , 1
  257.          IPOS=MLELEM.INDEX(IELEM)
  258.          IPOS1=MLELE1.INDEX(IELEM)
  259.          NLS1 =  MLELEM.LESPOI(IPOS)
  260.          NGS1 =  MELSOM.NUM(1,NLS1)
  261.          NVOIS1 = MTOUC.LECT(NLS1)
  262.          MLELE1.LESPOI(IPOS1)=NGS1
  263.          MLELE1.INDEX(IELEM+1)=MLELE1.INDEX(IELEM)+NVOIS1+1
  264.          DO INOEU = 1, NVOIS1, 1
  265.             NLS2 = MLELEM.LESPOI(IPOS+INOEU)
  266.             IF(NLS2 .EQ.0)THEN
  267.                WRITE(IOIMP,*) 'Subroutine rlexvb.eso'
  268.                CALL ERREUR(5)
  269.                GOTO 9999
  270.             ELSE
  271.                NGS2=MELSOM.NUM(1,NLS2)
  272.                MLELE1.LESPOI(IPOS1+INOEU)=NGS2
  273.             ENDIF
  274.          ENDDO
  275.       ENDDO
  276. C
  277.       SEGSUP MLELEM
  278.       MLELEM=MLELE1
  279. C
  280.       SEGSUP MLESOM
  281.       SEGSUP MPOS
  282.       SEGSUP MTOUC
  283.       SEGDES MLELEM
  284.       SEGDES MELSOM
  285.       SEGDES MELFL
  286. C
  287. C**** Problème détecté dans un cas test: mal-conditionnent
  288. C     de la matrice associé à la méthode de moindres carres
  289. C     aux bords.
  290. C     Quand possible, on elimine de MLELEM tous les voisins
  291. C     sommets qui sont sur le bord -> MLELE1
  292. C
  293.       SEGACT MLELEM
  294.       NBL=MLELEM.INDEX(/1)-1
  295.       NBTPOI=MLELEM.LESPOI(/1)
  296.       SEGINI MLELE1
  297. C
  298. C**** MLESOM.MLENTI contient les sommets aux bords
  299. C
  300.       JG=nbpts
  301.       SEGINI MLESOM
  302.       DO IELEM=1,NBL,1
  303.          IPOS=MLELEM.INDEX(IELEM)
  304.          NGS1=MLELEM.LESPOI(IPOS)
  305.          MLESOM.LECT(NGS1)=IELEM
  306.       ENDDO
  307. C
  308. C
  309. C**** On rempli MLELE1
  310. C
  311.       NBTPOI=0
  312.       NVOIS1=0
  313. C
  314. C**** Pour chaque SOMMET NGS1, NVOIS1 = nombre des voisins qui ne
  315. C     sont pas sur le bords
  316. C
  317.       IPOS1=MLELEM.INDEX(1)
  318.       DO IELEM=1,NBL,1
  319.          IPOS=IPOS1
  320.          IPOS1=MLELEM.INDEX(1+IELEM)
  321.          NBTPOI=NBTPOI+1
  322.          MLELE1.INDEX(IELEM)=NBTPOI
  323.          NGS1=MLELEM.LESPOI(IPOS)
  324.          MLELE1.LESPOI(NBTPOI)=NGS1
  325.          DO I1=IPOS+1,IPOS1-1,1
  326.             NGS2=MLELEM.LESPOI(I1)
  327.             NLS2=MLESOM.LECT(NGS2)
  328.             IF(NLS2.EQ.0)THEN
  329. C
  330. C************* NGS2 n'est pas sur le bord
  331. C
  332.                NVOIS1=NVOIS1+1
  333.                MLELE1.LESPOI(NBTPOI+NVOIS1)=NGS2
  334.             ENDIF
  335.          ENDDO
  336.          IF(NVOIS1.EQ.0)THEN
  337. C
  338. C********** Tous les voisins de NGS1 sont sur le bords
  339. C
  340.             DO I1=IPOS+1,IPOS1-1,1
  341.                NGS2=MLELEM.LESPOI(I1)
  342.                NVOIS1=NVOIS1+1
  343.                MLELE1.LESPOI(NBTPOI+NVOIS1)=NGS2
  344.             ENDDO
  345.          ENDIF
  346.          NBTPOI=NBTPOI+NVOIS1
  347.          NVOIS1=0
  348.       ENDDO
  349.       MLELE1.INDEX(NBL+1)=NBTPOI+1
  350. C
  351.       SEGSUP MLELEM
  352.       SEGADJ MLELE1
  353.       MLELEM=MLELE1
  354.       SEGDES MLELEM
  355.       SEGSUP MLESOM
  356. C
  357.  9999 RETURN
  358.       END
  359.  
  360.  
  361.  
  362.  

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