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