1 : C PRPAVE SOURCE CHAT 05/01/13 02:35:17 5004 2 : C PRPAVE POSITIONNE CORRECTEMENT 6 FACES DONNEES ET REGULARISE 3 : C (PAR L'APPEL DE PAVE) LE MAILLAGE DU CUBE CORRESPONDANT EN 4 : C EVITANT QUE DES POINTS DU MAILLAGE NE SE TROUVENT A L'EXTERIEUR 5 : C DANS LE CAS DE FACES CONCAVES. 6 : C 7 : SUBROUTINE PRPAVE 8 : IMPLICIT INTEGER(I-N) 9 : -INC SMELEME 10 : -INC CCOPTIO 11 : -INC SMCOORD 12 : C 12 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 12 : CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU) 12 : CALL LIROBJ('MAILLAGE',IPT3,1,IRETOU) 12 : CALL LIROBJ('MAILLAGE',IPT4,1,IRETOU) 12 : CALL LIROBJ('MAILLAGE',IPT5,1,IRETOU) 12 : CALL LIROBJ('MAILLAGE',IPT6,1,IRETOU) 13 : IF (IERR.NE.0) RETURN 14 : SEGACT IPT1,IPT2,IPT3,IPT4,IPT5,IPT6 14 : IF (IPT1.LISOUS(/1).NE.0) CALL ERREUR(16) 14 : IF (IPT2.LISOUS(/1).NE.0) CALL ERREUR(16) 14 : IF (IPT3.LISOUS(/1).NE.0) CALL ERREUR(16) 14 : IF (IPT4.LISOUS(/1).NE.0) CALL ERREUR(16) 14 : IF (IPT5.LISOUS(/1).NE.0) CALL ERREUR(16) 14 : IF (IPT6.LISOUS(/1).NE.0) CALL ERREUR(16) 14 : IF (IPT1.LISREF(/1).NE.4) CALL ERREUR(16) 14 : IF (IPT2.LISREF(/1).NE.4) CALL ERREUR(16) 14 : IF (IPT3.LISREF(/1).NE.4) CALL ERREUR(16) 14 : IF (IPT4.LISREF(/1).NE.4) CALL ERREUR(16) 14 : IF (IPT5.LISREF(/1).NE.4) CALL ERREUR(16) 14 : IF (IPT6.LISREF(/1).NE.4) CALL ERREUR(16) 14 : IF ((IPT1.ITYPEL.NE.8).AND.(IPT1.ITYPEL.NE.10)) CALL ERREUR(16) 14 : IF ((IPT2.ITYPEL.NE.8).AND.(IPT2.ITYPEL.NE.10)) CALL ERREUR(16) 14 : IF ((IPT3.ITYPEL.NE.8).AND.(IPT3.ITYPEL.NE.10)) CALL ERREUR(16) 14 : IF ((IPT4.ITYPEL.NE.8).AND.(IPT4.ITYPEL.NE.10)) CALL ERREUR(16) 14 : IF ((IPT5.ITYPEL.NE.8).AND.(IPT5.ITYPEL.NE.10)) CALL ERREUR(16) 14 : IF ((IPT6.ITYPEL.NE.8).AND.(IPT6.ITYPEL.NE.10)) CALL ERREUR(16) 15 : IF (IERR.NE.0) RETURN 16 : SEGACT MCOORD 17 : C 18 : C POSITIONNEMENT DES FACES ET CONTROLES DES COTES. 19 : C 20 : C IPT1:FACE 1 DU CUBE 20 : CALL COIN(IPT1,I1,I2,I3,I4,NX,NY) 21 : IF (IIMPI.NE.0) WRITE(IOIMP,9) I1,I2,I3,I4,NX,NY 22 : 9 FORMAT (' COINS : ',4(I3,1X),3X,'DIM :',I2,1X,I2) 23 : C 24 : C RECHERCHE DE LA POSITION DES FACES (POINTEES PAR IPT2,IPT3,IPT4 25 : C IPT5 ET IPT6) PAR RAPPORT A LA FACE 1. 26 : C 27 : IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6 27 : CALL POSIT(IPT2,I1,I2,I3,I4,J2) 27 : CALL POSIT(IPT3,I1,I2,I3,I4,J3) 27 : CALL POSIT(IPT4,I1,I2,I3,I4,J4) 27 : CALL POSIT(IPT5,I1,I2,I3,I4,J5) 27 : CALL POSIT(IPT6,I1,I2,I3,I4,J6) 28 : IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6 29 : IF (IIMPI.NE.0) WRITE(IOIMP,19) J2,J3,J4,J5,J6 30 : 19 FORMAT(' J2=',I3,' J3=',I3,' J4=',I3,' J5=',I3,' J6=',I3) 31 : 29 FORMAT('IPT1=',I3,' IPT2=',I3,' IPT3=',I3,' IPT4=',I3, 32 : 1 'IPT5=',I3,' IPT6=',I3) 33 : IF ((J2.EQ.J3).OR.(J2.EQ.J4).OR.(J2.EQ.J5).OR.(J2.EQ.J6).OR. 34 : 1 (J3.EQ.J4).OR.(J3.EQ.J5).OR.(J3.EQ.J6).OR.(J4.EQ.J5).OR. 34 : 2 (J4.EQ.J6).OR.(J5.EQ.J6)) CALL ERREUR(21) 35 : IF (IERR.NE.0) RETURN 36 : IP2=IPT2 37 : IP3=IPT3 38 : IP4=IPT4 39 : IP5=IPT5 40 : IP6=IPT6 40 : CALL AFFPAV(J2,IP2,IPT2,IPT3,IPT4,IPT5,IPT6) 40 : CALL AFFPAV(J3,IP3,IPT2,IPT3,IPT4,IPT5,IPT6) 40 : CALL AFFPAV(J4,IP4,IPT2,IPT3,IPT4,IPT5,IPT6) 40 : CALL AFFPAV(J5,IP5,IPT2,IPT3,IPT4,IPT5,IPT6) 40 : CALL AFFPAV(J6,IP6,IPT2,IPT3,IPT4,IPT5,IPT6) 41 : IF (IIMPI.NE.0) WRITE(IOIMP,29) IPT1,IPT2,IPT3,IPT4,IPT5,IPT6 42 : C 43 : C CONTROLE COTES FACE 1 AVEC LES COTES 1 DES FACES 2,3,4,5 ET 6 43 : CALL CTRLE(IPT5,IPT1,1,1) 43 : CALL CTRLE(IPT4,IPT1,1,2) 43 : CALL CTRLE(IPT6,IPT1,1,3) 43 : CALL CTRLE(IPT3,IPT1,1,4) 44 : C 45 : C POINTS I5,I6 ET DIMENSION NZ. 45 : CALL COIN(IPT5,IP1,IP2,I6,I5,N1,NZ) 46 : C 47 : C CONTROLE DES ARETES VERTICALES 47 : CALL CTRLE(IPT5,IPT4,2,4) 47 : CALL CTRLE(IPT4,IPT6,2,2) 47 : CALL CTRLE(IPT3,IPT6,2,4) 47 : CALL CTRLE(IPT3,IPT5,4,4) 48 : C 49 : C POSITIONNEMENT DE LA FACE 2 49 : CALL POS(IPT2,I5,I6,IND) 49 : IF (IND.EQ.0) CALL ERREUR(21) 50 : IF (IERR.NE.0) RETURN 51 : C 52 : C CONTROLE COTES FACE 2 AVEC COTES 3 DES FACES 3,4,5 ET 6 52 : CALL CTRLE(IPT2,IPT5,1,3) 52 : CALL CTRLE(IPT2,IPT4,2,3) 52 : CALL CTRLE(IPT2,IPT6,3,3) 52 : CALL CTRLE(IPT3,IPT2,3,4) 53 : C 54 : C MAILLAGE DU VOLUME. 54 : CALL PAVE(NX,NY,NZ,IPT1,IPT2,IPT3,IPT4,IPT5,IPT6) 55 : SEGDES IPT1,IPT2,IPT3,IPT4,IPT5,IPT6 56 : RETURN 57 : END 58 : C 59 : C 60 :
© Cast3M 2003 - All rights reserved.
Disclaimer