Sources Esope | Cast3M

connec
C CONNEC    SOURCE    PV        20/03/31    14:33:14     10567          
      SUBROUTINE CONNEC
C_______________________________________________________________________
C
C     CALCUL DU MCHAML DES ELEMENTS SE TROUVANT A UNE DISTANCE
C     INFERIEURE A XLONG DE CHAQUE ELEMENT DE MMODEL EVENTUELLEMENT
C     SYMETRISE OU TRANSLATE.
C
C     CHAM1=CONN MODL1 |FLOT1 |'NORMAL'                    (MOT1);
C                      |CHAM1 |'POINT'    POIN1             MOT1 ;
C                             |'DROITE'   POIN1 POIN2       MOT1 ;
C                             |'PLAN'     POIN1 POIN2 POIN3 MOT1 ;
C                             |'TRANS'    POIN1             MOT1 ;
C    APPEL A:
C
C    VCONMO : verification de la consistance du modele
C    CONNE1 : calcul effectif des connectivites
C    LLISTE : impression du champ de connectivite
C    LIROBJ, LIRREE, LIRMOT, LIRCHA
C
C    AUTEURS P.PEGON 18/11/91 C. LA BORDERIE MARS 92
C            P.PEGON 22/10/92
C_______________________________________________________________________
      IMPLICIT INTEGER(I-N)
      IMPLICIT  REAL*8(A-H,O-Z)
      CHARACTER*16 CONSTI
      CHARACTER*16 TT
      DATA TT/'CARACTERISTIQUES'/
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMCHAML
      CHARACTER*(NCONCH) CONM
C
C           IPMODL Pointeur sur un objet MMODEL
C           XLONG,IXLONG  Longueur caracteristique scalaire ou champ
C           JPT1|
C           JPT2|  pointeurs eventuels sur des objets de type point
C           JPT3|
C
C           IPCHCO Pointeur sur un MCHAML de Connectivite
C
C     LISTE DES MOTS CLE
C
      PARAMETER(NCLE=5)
      CHARACTER*4 MCLE(NCLE)
      DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
C
      segact mcoord
 
      JPT1=0
      JPT2=0
      JPT3=0
C
C     LECTURE DU MODEL ET VERIFICATION DE SA CONSISTANCE
C     (UN SEUL CONSTITUANT, UNE REGION GEOMETRIQUE SIMPLE)
C
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRET)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF(IRET.EQ.0) RETURN
      CALL VCONMO(IPMODL,IRET)
      IF(IRET.EQ.0) RETURN
C
C     LECTURE DU FLOTTANT ...
C
      CALL LIRREE(XLONG,0,IRET)
C
C     ... OU D'UN 'MCHAML' SOUS TYPE CHARACTERISTIQUE AUX PT DE GAUSS
C
      IXLONG=0
      IF(IRET.EQ.0) THEN
        CALL LIROBJ('MCHAML  ',IPIN,1,IRET)
        CALL ACTOBJ('MCHAML  ',IPIN,1)
 
        CALL REDUAF(IPIN,IPMODL,IXLONG,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
        CALL PLACHA(IXLONG,TT,1,IRET)
        IF(IRET.EQ.0) RETURN
        CALL QUESUP (IPMODL,IXLONG,5,1,IRET,IRET2)
        IF(IRET.NE.0) RETURN
      ENDIF
C
C     LECTURE DU MOT CLE ET ACTION SPECIFIQUE RELATIVE
C
      ICLE=0
      CALL LIRMOT(MCLE,NCLE,ICLE,1)
      IF(ICLE.EQ.0) RETURN
C
      GOTO(10,20,30,40,50),ICLE
C
C     OPTION NORMALE
C
   10 CONTINUE
      CALL LIRCHA(CONM,0,IRET)
      GOTO 100
C
C     OPTION TRANS
C
   20 CONTINUE
      CALL LIROBJ('POINT   ',JPT1,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIRCHA(CONM,1,IRET)
      IF(IRET.EQ.0) RETURN
      GOTO 100
C
C     OPTION POINT
C
   30 CONTINUE
      CALL LIROBJ('POINT   ',JPT1,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIRCHA(CONM,1,IRET)
      IF(IRET.EQ.0) RETURN
      GOTO 100
C
C     OPTION DROITE
C
   40 CONTINUE
      CALL LIROBJ('POINT ',JPT1,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIROBJ('POINT ',JPT2,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIRCHA(CONM,1,IRET)
      IF(IRET.EQ.0) RETURN
      GOTO 100
C
C     OPTION PLAN
C
   50 CONTINUE
      IF(IDIM.NE.3)THEN
        CALL ERREUR(752)
        RETURN
      ENDIF
      CALL LIROBJ('POINT ',JPT1,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIROBJ('POINT ',JPT2,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIROBJ('POINT ',JPT3,1,IRET)
      IF(IRET.EQ.0) RETURN
      CALL LIRCHA(CONM,1,IRET)
      IF(IRET.EQ.0) RETURN
      GOTO 100
C
C     NOM DU CONSTITUANT
C
 100  CONTINUE
      IF(IRET.GT.12)GOTO 999
      CONSTI=' '
      IF(IRET.NE.0) CONSTI(1:IRET)=CONM(1:IRET)
      CONSTI(13:16)=MCLE(ICLE)
C
C     CALCUL EFFECTIF
C
      CALL CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
     >             IPCHCO,IRET)
C
C     ECRITURE DU MCHAML
C
      IF(IRET.EQ.1) THEN
        CALL ACTOBJ('MCHAML  ',IPCHCO,1)
        CALL ECROBJ('MCHAML  ',IPCHCO)
        IF (IIMPI.EQ.2)CALL LLISTE(IPCHCO)
      ENDIF
      RETURN
 
C----------------ERREURS------------------------------------------
 999  CONTINUE
      CALL ERREUR(751)
      END