C CONNE1 SOURCE AM 17/09/25 21:15:00 9566 > IPCHCO,IRET) C_______________________________________________________________________ C C CALCUL DES CONNECTIVITES APPELE PAR CONNEC C C Entrees: C ________ C C IPMODL Pointeur sur un objet MMODEL C XLONG Longeur caracteristique C IXLONG Champ de longeur caracteristique C CONSTI nom du constituant C ICLE mode de modification du maillage pour le calcul C (1=NORM, 3=POIN, 4=DROI, 5=PLAN, 2=TRAN) C JPT1| C JPT2| pointeurs eventuels sur des objets de type point C JPT3| C C C Sorties: C ________ C C IPCHCO Pointeur sur un MCHAML de Connectivite C de composantes obligatoires ... C C 'NLAR': Non local Longueur cARacteristique C 'PMOD': Pointeur sur un MMODEL contenant C l'ensemble des IMODEL accessibles C pour la sous zone C 'NPNI': Non local Pointeur Numero Imodel de nmod C 'NPLI': Non local Pointeur LIstenti C C ... et eventuellement C C 'POT1': Point ou vecteur de construction de symetrie C (POIN, DROI, PLAN, TRAN) C 'POT2': Point de construction de symetrie (DROI) C 'DISP': Distance pour calcul de symetrie PLAN (PLAN) C C IRET 1 ou 0 suivant succes ou pas C C Appele par: CONNEC C ----------- C C Appel a: C -------- C C LOADPO : lecture d'un point (pointeur --> x(3)) C NORPLA : calcul de l'eq. canonique d'un plan passant par 3 pts C ADJUPO : ajout d'un point dans la pile des points (x(3) --> pointeur) C NORDRO : calcul du vect. dir. norme de la droite passant par 2 pts C DISYPT : distance a un point C DISYDR : distance a une droite C DISYPL : distance a un plan C TRTRVE : point translate C TRSYPT : point symetrique par rapport a un point C TRSYDR : point symetrique par rapport a une droite C TRSYPL : point symetrique par rapport a un plan C ELQUOI, DOXE, DTSHAM C C AUTEUR P.PEGON 22/10/92 d'apres C. LA BORDERIE d'apres P.PEGON C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) DIMENSION PT1(3),PT2(3),PT3(3) C -INC SMMODEL -INC CCOPTIO -INC SMELEME -INC SMCOORD -INC SMCHAML -INC SMLENTI C SEGMENT,INFO INTEGER INFELL(JG) ENDSEGMENT C SEGMENT,WRK1 REAL*8 XE(3,NBNN) ENDSEGMENT C SEGMENT,WRK2 REAL*8 XEJ(3,NBNJ) ENDSEGMENT C POINTEUR IPMAIL.MELEME POINTEUR MLNUEL.MLENTI POINTEUR MLNIMO.MLENTI C CHARACTER*(NCONCH) CONM PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT * SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT C DATA XMULTL/1.5/ C C LECTURE DES POINTS C C C CALCUL DE LA NORMALE NORMEE ET DE LA DISTANCE POUR LE CAS C DU PLAN, ET AJOUT DU POINT A LA PILE C IF(ICLE.EQ.5)THEN ENDIF C C CALCUL DU VECTEUR DIRECTEUR NORME DANS LE CAS DE LA DROITE C ET AJOUT DU POINT A LA PILE C IF(ICLE.EQ.4)THEN CALL NORDRO(PT1,PT2,PT2) ENDIF C IRET=1 C C____________________________________________________________________ C C PREPARATIONS DE LA LONGUEUR CARACTERISTIQUE C____________________________________________________________________ C IF(IXLONG.NE.0)THEN C INFOS(1)=0 INFOS(2)=0 INFOS(3)=NIFOUR C NBROBL=1 NBRFAC=0 SEGINI NOMID NOMLAR=NOMID LESOBL(1)='LCAR' NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' ELSE XLONG2=(XMULTL*XLONG)**2 ENDIF C C ACTIVATION DU MODELE C MMODEL=IPMODL SEGACT,MMODEL NSOUS=KMODEL(/1) C C ACTIVATION DES ZONES ELEMENTAIRES DU MAILLAGE C DO 1 ISOUS=1,NSOUS IMODEL=KMODEL(ISOUS) SEGACT,IMODEL IPMAIL=IMAMOD SEGACT,IPMAIL 1 CONTINUE C C CREATION DU MCHELM C N1=NSOUS L1=22 N3=6 SEGINI,MCHELM IPCHCO=MCHELM TITCHE='CONNECTIVITE NON LOCAL' IFOCHE=IFOUR C____________________________________________________________________ C C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES C____________________________________________________________________ C DO 500 ISOUS=1,NSOUS IMODEL=KMODEL(ISOUS) IPMAIL=IMAMOD CONM =CONMOD NBNN =IPMAIL.NUM(/1) C____________________________________________________________________ C C INFORMATION SUR L'ELEMENT FINI C____________________________________________________________________ C MELE=IPMAIL.ITYPEL IF(infmod(/1).lt.7) then IF (IERR.NE.0) THEN GOTO 9999 ENDIF INFO=IPINF MINTE=INFELL(11) segsup INFO ELSE minte=infmod(7) ENDIF C C COMPLEMENT MCHELM C IMACHE(ISOUS)=IPMAIL C INFCHE(ISOUS,1)=0 INFCHE(ISOUS,2)=0 INFCHE(ISOUS,3)=NIFOUR INFCHE(ISOUS,4)=MINTE INFCHE(ISOUS,5)=0 INFCHE(ISOUS,6)=5 C____________________________________________________________________ C C KOMCHA DANS LE CAS DU CHAMP DE LONGUEUR CHARAC C____________________________________________________________________ C IF(IXLONG.NE.0)THEN IF (IERR.NE.0) THEN NOMID=NOMLAR NOTYPE=MOTYPE SEGSUP,NOMID,NOTYPE GOTO 9999 ENDIF ENDIF C C____________________________________________________________________ C C TAILLE DES MELVAL A ALLOUER ET ALLOCATION C____________________________________________________________________ C C C CREATION DU MCHAML DE LA SOUS ZONE C IF(ICLE.EQ.1)N2=4 IF(ICLE.EQ.2.OR.ICLE.EQ.3)N2=5 IF(ICLE.EQ.4.OR.ICLE.EQ.5)N2=6 SEGINI,MCHAML ICHAML(ISOUS)=MCHAML C C CREATION DU PREMIER MELVAL C C 'NLAR' : DONNE LA LONGUEUR CARACTERISTIQUE C C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE C NOMCHE(1)='NLAR' TYPCHE(1)='REAL*8' N2PTEL=0 N2EL=0 C IF(IXLONG.NE.0)THEN MPTVAL=IVALAR MELVAL=IVAL(1) SEGINI,MELVA1=MELVAL IELVAL(1)=MELVA1 ELSE C N1PTEL=1 N1EL=1 SEGINI,MELVAL IELVAL(1)=MELVAL VELCHE(1,1)=XLONG C ENDIF C C C CREATION DU DEUXIEME MELVAL C C 'PMOD' : POINTE SUR UN MODELE INDIQUANT LES ZONES GEOMETRIQUE C C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE C N1PTEL=0 N1EL=0 N2PTEL=1 N2EL=1 NOMCHE(2)='PMOD' TYPCHE(2)='POINTEURMMODEL ' SEGINI MELVAL IELVAL(2)=MELVAL IELCHE(1,1)=MMODEL C C C 'NPNI' : POINTE SUR UN LISTENTI CONTENANT LE NUMERO DE IMODEL C ACCESSIBLE POUR CHAQUE ELEMENT C 'NPLI' : POINTE SUR UN LISTENTI CONTENANT UNE LINKED LISTE C DES ELEMENTS ACCESSIBLES SUR CHAQUE ZONES C C N1EL=0 N1PTEL=0 N2PTEL=1 N2EL=NBEL NOMCHE(3)='NPNI' TYPCHE(3)='POINTEURLISTENTI' SEGINI,MELVAL IELVAL(3)=MELVAL NOMCHE(4)='NPLI' TYPCHE(4)='POINTEURLISTENTI' SEGINI,MELVAL IELVAL(4)=MELVAL C C C 'POT1' : POINTE SUR UN OBJET DE TYPE POINT C C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE C IF(ICLE.NE.1)THEN N1PTEL=0 N1EL=0 N2PTEL=1 N2EL=1 NOMCHE(5)='POT1' TYPCHE(5)='POINTEURPOINT ' SEGINI MELVAL IELVAL(5)=MELVAL IELCHE(1,1)=JPT1 ENDIF C C C 'POT2' : POINTE SUR UN OBJET DE TYPE POINT C C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE C IF(ICLE.EQ.4)THEN N1PTEL=0 N1EL=0 N2PTEL=1 N2EL=1 NOMCHE(6)='POT2' TYPCHE(6)='POINTEURPOINT ' SEGINI MELVAL IELVAL(6)=MELVAL IELCHE(1,1)=JPT2 ENDIF C C 'DISP' : DONNE LA DISTANCE AU PLAN C C CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE C IF(ICLE.EQ.5)THEN N2PTEL=0 N2EL=0 N1PTEL=1 N1EL=1 NOMCHE(6)='DISP' TYPCHE(6)='REAL*8' SEGINI,MELVAL IELVAL(6)=MELVAL VELCHE(1,1)=D ENDIF C C____________________________________________________________________ C C BOUCLE SUR LES ELEMENTS DE LA SS ZONE C____________________________________________________________________ C SEGINI,WRK1 C C ON CHERCHE LA LONGUEUR MAX SUR L'ELEMENT C IF(IXLONG.NE.0)THEN MELVAL=IELVAL(1) XLONGM=0.D0 NBGLAR=VELCHE(/1) DO IGAU=1,NBGLAR XLONGM=MAX(XLONGM,VELCHE(IGAU,MIN(IB,VELCHE(/2)))) ENDDO XLONG2=(XMULTL*XLONGM)**2 ENDIF C C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB C C C SI L'ELEMENT EST A PLUS DE XLONG D'UNE SYMETRIE IL C N'Y A PAS DE CONNECTIVITE POSSIBLE C XXL2M=0.D0 IF(ICLE.EQ.3)CALL DISYPT(XE,NBNN,PT1, XXL2M) IF(ICLE.EQ.5)CALL DISYPL(XE,NBNN,PT1,D , XXL2M) IF(XXL2M.GE.XLONG2)THEN MELVAL=IELVAL(3) IELCHE(1,IB)=0 MELVAL=IELVAL(4) IELCHE(1,IB)=0 ELSE C C CREATION DU PREMIER LISTENTI C JG=0 SEGINI MLNIMO MELVAL=IELVAL(3) IELCHE(1,IB)=MLNIMO C C CREATION DU DDUXIEME LISTENTI C JG=0 SEGINI,MLENTI MELVAL=IELVAL(4) IELCHE(1,IB)=MLENTI C____________________________________________________________________ C C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES ACCESSIBLES C____________________________________________________________________ C DO 450 ISOUSJ=1,NSOUS IMODE1=KMODEL(ISOUSJ) IPT1=IMODE1.IMAMOD NBELEJ=IPT1.NUM(/2) NBNJ =IPT1.NUM(/1) * PV faux et non utilisé MINTE =INFCHE(4,ISOUSJ) C____________________________________________________________________ C C BOUCLE SUR LES ELEMENTS DE LA SS ZONE C____________________________________________________________________ C SEGINI,WRK2 JG=0 SEGINI,MLNUEL DO 449 IBJ=1,NBELEJ C C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IBJ(ISOUSJ) C C C ON TRANSFORME CES COORDONNEES EN FONCTION DES SYMETRIE OU DE LA C TRANSLATION C IF(ICLE.EQ.2)CALL TRTRVE(XEJ,NBNJ,PT1 ) IF(ICLE.EQ.3)CALL TRSYPT(XEJ,NBNJ,PT1 ) IF(ICLE.EQ.5)CALL TRSYPL(XEJ,NBNJ,PT1,D ) C C ON CHERCHE SI UN DES NOEUDS DE XE SE TROUVE A MOINS DE C XLONG DE L'UN DES NOEUDS DE XEJ C DO 4 IE1=1,NBNN DO 4 IE2=1,NBNJ XXLON2=0.D0 DO 3 IE3=1,IDIM XXLON2=XXLON2+(XE(IE3,IE1)-XEJ(IE3,IE2))**2 3 CONTINUE IF(XXLON2.LT.XLONG2)GOTO 6 4 CONTINUE GOTO 449 C C SI C'EST VRAI, ON NOTE LE NUMERO DE L'ELEMENT DANS MLNUEL C 6 JG=JG+1 SEGADJ,MLNUEL MLNUEL.LECT(JG)=IBJ 449 CONTINUE C C NOMBRE D'ELEMENTS ACCESSIBLES C NELEAC=JG SEGSUP,WRK2 C C SI MLNUEL N'EST PAS VIDE, ON INFORME MLNIMO ET MLENTI C IF(NELEAC.GT.0)THEN NSZA=MLNIMO.LECT(/1) JG=NSZA+1 SEGADJ,MLNIMO MLNIMO.LECT(JG)=ISOUSJ JG1=LECT(/1) JG=JG1+NELEAC+1 SEGADJ,MLENTI LECT(JG1+1)=NELEAC DO IELEAC=1,NELEAC IG1=JG1+1+IELEAC LECT(IG1)=MLNUEL.LECT(IELEAC) C print*,'elemnt acc',lect(ig1) END DO ENDIF SEGSUP,MLNUEL 450 CONTINUE C C ON VERIFIE LA PRESENCE DE CONNECTIVITE ET ON MET EVENTUELLEMENT C LES POINTEURS A ZERO C NSZA=MLNIMO.LECT(/1) IF(NSZA.EQ.0)THEN SEGSUP,MLNIMO,MLENTI MELVAL=IELVAL(3) IELCHE(1,IB)=0 MELVAL=IELVAL(4) IELCHE(1,IB)=0 ELSE SEGDES,MLNIMO SEGDES,MLENTI ENDIF ENDIF C 499 CONTINUE SEGSUP,WRK1 C____________________________________________________________________ C C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS C____________________________________________________________________ C * INFO=IPINF * SEGSUP,INFO MELVAL=IELVAL(1) SEGDES,MELVAL MELVAL=IELVAL(2) SEGDES,MELVAL MELVAL=IELVAL(3) SEGDES,MELVAL MELVAL=IELVAL(4) SEGDES,MELVAL SEGDES,MCHAML 500 CONTINUE C____________________________________________________________________ C C DESACTIVATION DES CHAMPS GLOBAUX C____________________________________________________________________ C SEGDES,MCHELM C DO 8 IE1=1,NSOUS IMODEL=KMODEL(IE1) IPMAIL=IMAMOD C PRINT*,IE1,IMODEL,IPMAIL SEGDES,IMODEL SEGDES,IPMAIL 8 CONTINUE SEGDES,MMODEL C IF(IXLONG.NE.0)THEN NOMID=NOMLAR NOTYPE=MOTYPE SEGSUP,NOMID,NOTYPE ENDIF C RETURN C____________________________________________________________________ C C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR C____________________________________________________________________ C 9999 CONTINUE IF(ISOUS.GT.1)THEN DO 9991 IE1=1,ISOUS 9991 CONTINUE ENDIF SEGSUP,MCHELM IPCHCO=0 IRET=0 C DO 10 IE1=1,NSOUS IMODEL=KMODEL(IE1) IPMAIL=IMAMOD SEGDES,IPMAIL,IMODEL 10 CONTINUE SEGDES,MMODEL RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales