Download connec.eso

Back to the list

   1 : C CONNEC    SOURCE    PV        09/03/12    21:18:08     6325           
   2 :       SUBROUTINE CONNEC
   3 : C_______________________________________________________________________
   4 : C
   5 : C     CALCUL DU MCHAML DES ELEMENTS SE TROUVANT A UNE DISTANCE
   6 : C     INFERIEURE A XLONG DE CHAQUE ELEMENT DE MMODEL EVENTUELLEMENT
   7 : C     SYMETRISE OU TRANSLATE.
   8 : C
   9 : C     CHAM1=CONN MODL1 |FLOT1 |'NORMAL'                    (MOT1);
  10 : C                      |CHAM1 |'POINT'    POIN1             MOT1 ;
  11 : C                             |'DROITE'   POIN1 POIN2       MOT1 ;
  12 : C                             |'PLAN'     POIN1 POIN2 POIN3 MOT1 ;
  13 : C                             |'TRANS'    POIN1             MOT1 ;
  14 : C    APPEL A:
  15 : C
  16 : C    VCONMO : verification de la consistance du modele
  17 : C    CONNE1 : calcul effectif des connectivites
  18 : C    LLISTE : impression du champ de connectivite
  19 : C    LIROBJ, LIRREE, LIRMOT, LIRCHA
  20 : C
  21 : C    AUTEURS P.PEGON 18/11/91 C. LA BORDERIE MARS 92
  22 : C            P.PEGON 22/10/92
  23 : C_______________________________________________________________________
  24 :       IMPLICIT INTEGER(I-N)
  25 :       IMPLICIT  REAL*8(A-H,O-Z)
  26 :       CHARACTER*16 CONSTI
  27 :       CHARACTER*16 TT
  28 :       DATA TT/'CARACTERISTIQUES'/
  29 : -INC CCOPTIO
  30 : -INC SMCOORD
  31 : -INC SMCHAML
  32 :       CHARACTER*(NCONCH) CONM
  33 : C
  34 : C           IPMODL Pointeur sur un objet MMODEL
  35 : C           XLONG,IXLONG  Longueur caracteristique scalaire ou champ
  36 : C           JPT1|
  37 : C           JPT2|  pointeurs eventuels sur des objets de type point
  38 : C           JPT3|
  39 : C
  40 : C           IPCHCO Pointeur sur un MCHAML de Connectivite
  41 : C
  42 : C     LISTE DES MOTS CLE
  43 : C
  44 :       PARAMETER(NCLE=5)
  45 :       CHARACTER*4 MCLE(NCLE)
  46 :       DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
  47 : C
  48 :       JPT1=0
  49 :       JPT2=0
  50 :       JPT3=0
  51 : C
  52 : C     LECTURE DU MODEL ET VERIFICATION DE SA CONSISTANCE
  53 : C     (UN SEUL CONSTITUANT, UNE REGION GEOMETRIQUE SIMPLE)
  54 : C
  54 :       CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  55 :       IF(IRET.EQ.0) RETURN
  55 :       CALL VCONMO(IPMODL,IRET)
  56 :       IF(IRET.EQ.0) RETURN
  57 : C
  58 : C     LECTURE DU FLOTTANT ...
  59 : C
  59 :       CALL LIRREE(XLONG,0,IRET)
  60 : C
  61 : C     ... OU D'UN 'MCHAML' SOUS TYPE CHARACTERISTIQUE AUX PT DE GAUSS
  62 : C
  63 :       IXLONG=0
  64 :       IF(IRET.EQ.0) THEN
  64 :         CALL LIROBJ('MCHAML',IXLONG,1,IRET)
  65 :         IF(IRET.EQ.0) RETURN
  65 :         CALL PLACHA(IXLONG,TT,1,IRET)
  66 :         IF(IRET.EQ.0) RETURN
  66 :         CALL QUESUP (IPMODL,IXLONG,5,1,IRET,IRET2)
  67 :         IF(IRET.NE.0) RETURN
  68 :       ENDIF
  69 : C
  70 : C     LECTURE DU MOT CLE ET ACTION SPECIFIQUE RELATIVE
  71 : C
  72 :       ICLE=0
  72 :       CALL LIRMOT(MCLE,NCLE,ICLE,1)
  73 :       IF(ICLE.EQ.0) RETURN
  74 : C
  75 :       GOTO(10,20,30,40,50),ICLE
  76 : C
  77 : C     OPTION NORMALE
  78 : C
  79 :    10 CONTINUE
  79 :       CALL LIRCHA(CONM,0,IRET)
  80 :       GOTO 100
  81 : C
  82 : C     OPTION TRANS
  83 : C
  84 :    20 CONTINUE
  84 :       CALL LIROBJ('POINT ',JPT1,1,IRET)
  85 :       IF(IRET.EQ.0) RETURN
  85 :       CALL LIRCHA(CONM,1,IRET)
  86 :       IF(IRET.EQ.0) RETURN
  87 :       GOTO 100
  88 : C
  89 : C     OPTION POINT
  90 : C
  91 :    30 CONTINUE
  91 :       CALL LIROBJ('POINT ',JPT1,1,IRET)
  92 :       IF(IRET.EQ.0) RETURN
  92 :       CALL LIRCHA(CONM,1,IRET)
  93 :       IF(IRET.EQ.0) RETURN
  94 :       GOTO 100
  95 : C
  96 : C     OPTION DROITE
  97 : C
  98 :    40 CONTINUE
  98 :       CALL LIROBJ('POINT ',JPT1,1,IRET)
  99 :       IF(IRET.EQ.0) RETURN
  99 :       CALL LIROBJ('POINT ',JPT2,1,IRET)
 100 :       IF(IRET.EQ.0) RETURN
 100 :       CALL LIRCHA(CONM,1,IRET)
 101 :       IF(IRET.EQ.0) RETURN
 102 :       GOTO 100
 103 : C
 104 : C     OPTION PLAN
 105 : C
 106 :    50 CONTINUE
 107 :       IF(IDIM.NE.3)THEN
 107 :         CALL ERREUR(752)
 108 :         RETURN
 109 :       ENDIF
 109 :       CALL LIROBJ('POINT ',JPT1,1,IRET)
 110 :       IF(IRET.EQ.0) RETURN
 110 :       CALL LIROBJ('POINT ',JPT2,1,IRET)
 111 :       IF(IRET.EQ.0) RETURN
 111 :       CALL LIROBJ('POINT ',JPT3,1,IRET)
 112 :       IF(IRET.EQ.0) RETURN
 112 :       CALL LIRCHA(CONM,1,IRET)
 113 :       IF(IRET.EQ.0) RETURN
 114 :       GOTO 100
 115 : C
 116 : C     NOM DU CONSTITUANT
 117 : C
 118 :  100  CONTINUE
 119 :       IF(IRET.GT.12)GOTO 999
 120 :       CONSTI=' '
 121 :       IF(IRET.NE.0) CONSTI(1:IRET)=CONM(1:IRET)
 122 :       CONSTI(13:16)=MCLE(ICLE)
 123 : C
 124 : C     CALCUL EFFECTIF
 125 : C
 125 :       CALL CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
 126 :      >             IPCHCO,IRET)
 127 : C
 128 : C     ECRITURE DU MCHAML
 129 : C
 130 :       IF(IRET.EQ.1) THEN
 130 :         CALL ECROBJ('MCHAML',IPCHCO)
 130 :         IF (IIMPI.EQ.2)CALL LLISTE(IPCHCO)
 131 :       ENDIF
 132 : C
 133 :       RETURN
 134 : C----------------ERREURS------------------------------------------
 135 :  999  CONTINUE
 135 :       CALL ERREUR(751)
 136 :       RETURN
 137 :       END
 138 :  
 139 :  
 140 :  
 141 :  

© Cast3M 2003 - All rights reserved.
Disclaimer