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