Numérotation des lignes :

elstru
C ELSTRU    SOURCE    FANDEUR   10/12/14    21:16:02     6812      SUBROUTINE ELSTRUCC    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC    INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN MELEME (SOUS GEOMC    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC      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)CC     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)=IRETCC    ... LECTURE DU MELEMEC      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 MELEMEC *** LE MELEME N'EST PAS ELEMENTAIRE          INTERR(1)=MELEME          CALL ERREUR(89)          RETURN        ENDIF      ENDIFCC     LECTURE DE LA SOUS-STRUCTUREC      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      ENDIFC      NBPT=NUM(/2)      SEGINI ITRAV      DO 20 L=1,NBPT      ITRAV(**)=NUM(1,L)   20 CONTINUE      SEGDES MELEME      IMEL=MELEMEC      MSTRUC=KOBJET      SEGACT MSTRUC      NSTRU=LISTRU(/1)      IF(NSTRU.EQ.1) GOTO 30CC   LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIREC      CALL LIRENT(NSTRU,1,IRETOU)      IF(IERR.EQ.0) GOTO 30      SEGDES MSTRUC      SEGSUP ITRAVC *** LE MELEM DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE      INTERR(1)=MSTRUC      CALL ERREUR(90)      RETURN   30 MSOSTU=LISTRU(NSTRU)CC    LE MELEME DOIT ETRE INCLUS DANS LA SOUS-STRUCTUREC           SEGINI ITRA1      SEGACT MSOSTU      IF(ISRAID.EQ.0) THEN          MCHELM=ISCHAM(1)          SEGDES MSOSTU          SEGACT MCHELM          NSOUS=IMACHE(/1)CC  ******** BOUCLE SUR LES ZONES GEO.ELEM. DU CHAMP DE MATERIAUC          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)CC   BOUCLE SUR LES ZONES GEOMETRIQUES DE LA SOUS STRUCTUREC           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 CONTINUEC  *** 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 MSTRUCCC     ECRITURE DU MELSTRC      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