Télécharger elstru.eso

Retour à la liste

elstru
C ELSTRU    SOURCE    FANDEUR   10/12/14    21:16:02     6812
      SUBROUTINE ELSTRU
C
C    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C    INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN MELEME (SOUS GEOM
C    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMELSTR
-INC SMSTRUC
-INC SMELEME
-INC SMRIGID
-INC SMCHAML
      SEGMENT ITRAV(0)
      SEGMENT ITRA1(0)
C
C     LECTURE DU POINT OU ...
C
      CALL LIROBJ('POINT   ',IRET,0,IRETOU)
      IF(IRETOU.EQ.1) THEN
        NBNN=1
        NBELEM=1
        NBSOUS=0
        NBREF=0
        SEGINI MELEME
        ITYPEL=1
        NUM(1,1)=IRET
C
C    ... LECTURE DU MELEME
C
      ELSE
        CALL LIROBJ('MAILLAGE',IRET,1,IRETOU)
C *** PAS D'OBJET DE TYPE ELEMENT OU POINT
        IF(IERR.NE.0) THEN
          MOTERR(1:8)='MAILLAGE'
          CALL ERREUR(37)
          MOTERR(9:16)='POINT'
          CALL ERREUR(37)
          RETURN
        ENDIF
        MELEME=IRET
        SEGACT MELEME
        IF (ITYPEL.NE.1) THEN
          SEGDES MELEME
C *** LE MELEME N'EST PAS ELEMENTAIRE
          INTERR(1)=MELEME
          CALL ERREUR(89)
          RETURN
        ENDIF
      ENDIF
C
C     LECTURE DE LA SOUS-STRUCTURE
C
      CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU)
      IF(IERR.NE.0) THEN
        MOTERR(1:8)='STRUCTUR'
C *** PAS D'OBJET DE TYPE STRUCTURE
        CALL ERREUR(37)
        RETURN
      ENDIF
C
      NBPT=NUM(/2)
      SEGINI ITRAV
      DO 20 L=1,NBPT
      ITRAV(**)=NUM(1,L)
   20 CONTINUE
      SEGDES MELEME
      IMEL=MELEME
C
      MSTRUC=KOBJET
      SEGACT MSTRUC
      NSTRU=LISTRU(/1)
      IF(NSTRU.EQ.1) GOTO 30
C
C   LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE
C
      CALL LIRENT(NSTRU,1,IRETOU)
      IF(IERR.EQ.0) GOTO 30
      SEGDES MSTRUC
      SEGSUP ITRAV
C *** LE MELEM DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE
      INTERR(1)=MSTRUC
      CALL ERREUR(90)
      RETURN
   30 MSOSTU=LISTRU(NSTRU)
C
C    LE MELEME DOIT ETRE INCLUS DANS LA SOUS-STRUCTURE
C
           SEGINI ITRA1
      SEGACT MSOSTU
      IF(ISRAID.EQ.0) THEN
          MCHELM=ISCHAM(1)
          SEGDES MSOSTU
          SEGACT MCHELM
          NSOUS=IMACHE(/1)
C
C  ******** BOUCLE SUR LES ZONES GEO.ELEM. DU CHAMP DE MATERIAU
C
          DO 49 IAB=1,NSOUS
               MELEME=IMACHE(IAB)
               SEGACT MELEME
               IF(ITYPEL.EQ.22) GO TO 47
               NBELEM=NUM(/2)
               NBP=NUM(/1)
               DO 41 NBE=1,NBELEM
               DO 41 NP=1,NBP
                     ITRA1(**)=NUM(NP,NBE)
   41          CONTINUE
   47          SEGDES MELEME
   49     CONTINUE
          SEGDES,MCHELM
      ELSE
           MRIGID=ISRAID
           SEGACT MRIGID
           NRIGEL=IRIGEL(/2)
C
C   BOUCLE SUR LES ZONES GEOMETRIQUES DE LA SOUS STRUCTURE
C
           DO 55 IAA=1,NRIGEL
           MELEME=IRIGEL(1,IAA)
           SEGACT MELEME
           IF(ITYPEL.EQ.22) GOTO 50
           NBELEM=NUM(/2)
           NBP=NUM(/1)
           DO 40 NBE=1,NBELEM
           DO 40 NP=1,NBP
               ITRA1(**)=NUM(NP,NBE)
   40      CONTINUE
   50      SEGDES MELEME
   55      CONTINUE
           SEGDES MRIGID
      ENDIF
      NL=ITRA1(/1)
      DO 65 I=1,NBPT
      IKI=ITRAV(I)
      DO 60 J=1,NL
      IF(ITRA1(J).EQ.IKI) GOTO 65
   60 CONTINUE
C  *** UN PT DU MELEME N'APPARTIENT PAS A LA SS STRUCTURE
      INTERR(1)=IKI
      INTERR(2)=MSTRUC
      CALL ERREUR(91)
      GOTO 100
   65 CONTINUE
      SEGSUP ITRAV
      SEGSUP ITRA1
      N=1
      SEGINI MELSTR
      IMELEM(1)=IMEL
      ISOSTU(1)=MSOSTU
      SEGDES MSOSTU
      SEGDES MSTRUC
C
C     ECRITURE DU MELSTR
C
      CALL ECROBJ('ELEMSTRU',MELSTR)
      SEGDES MELSTR
      RETURN
  100 CONTINUE
      SEGSUP ITRAV
      SEGSUP ITRA1
      RETURN
      END
 
 
 
 

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