1 : C CHPCOO SOURCE PASCAL 12/12/12 21:15:02 7605 2 : C CREE UN (DES) CHAMP(S) POINT TYPE SCAL A PARTIR DES COORDONNEES. 3 : C 4 : SUBROUTINE CHPCOO (IVAL,MELEME) 5 : C 6 : C IVAL VAUT 1 ON VEUT CREER UN SEUL CHPOINT CONTENANT LA 7 : C 1 ERE COORDONNES DES NOEUDS DE L'OBJET IMELE 8 : C 2 IDEM POUR LA 2 EME COORDONNEES 9 : C 3 IDEM POUR LA 3 EME COORDONNEES 10 : C 0 ON CREE AUTANT DE CHPOINT QUE IDIM 11 : C IMELE EST LE POINTEUR SUR L'OBJET GEOMETRIQUE 12 : C 13 : IMPLICIT INTEGER(I-N) 14 : -INC CCOPTIO 15 : -INC SMELEME 16 : -INC SMCHPOI 17 : -INC SMCOORD 18 : SEGACT MELEME 19 : 20 : C CAS DU MAILLAGE VIDE 21 : C 22 : ISOU1=LISOUS(/1) 23 : IF (ITYPEL.EQ.0.AND.ISOU1.EQ.0) THEN 24 : SEGDES,MELEME 25 : NAT=1 26 : NSOUPO=0 27 : SEGINI,MCHPOI 28 : MCHPOI.IFOPOI=IFOUR 29 : MCHPOI.JATTRI(1)=1 30 : SEGDES,MCHPOI 30 : CALL ECROBJ('CHPOINT',MCHPOI) 31 : IF (IVAL.EQ.0) THEN 32 : IF (IDIM.EQ.2) THEN 33 : SEGINI,MCHPO1 34 : MCHPO1.IFOPOI=IFOUR 35 : MCHPO1.JATTRI(1)=1 36 : SEGDES,MCHPO1 36 : CALL ECROBJ('CHPOINT',MCHPO1) 37 : ELSEIF (IDIM.EQ.3) THEN 38 : SEGINI,MCHPO1 39 : MCHPO1.IFOPOI=IFOUR 40 : MCHPO1.JATTRI(1)=1 41 : SEGDES,MCHPO1 41 : CALL ECROBJ('CHPOINT',MCHPO1) 42 : SEGINI,MCHPO2 43 : MCHPO2.IFOPOI=IFOUR 44 : MCHPO2.JATTRI(1)=1 45 : SEGDES,MCHPO2 45 : CALL ECROBJ('CHPOINT',MCHPO2) 46 : ENDIF 47 : ENDIF 48 : RETURN 49 : ENDIF 50 : C 51 : C 52 : C 53 : C AUTRES CAS 54 : C 54 : IF( ITYPEL.NE.1) CALL CHANGE (MELEME,1) 55 : NBPOIN=NUM(/2) 56 : SEGACT MCOORD 57 : NDE=1 58 : NFI=IDIM+1 59 : IF(IVAL.NE.0) THEN 60 : NDE=IVAL 61 : NFI=IVAL+1 62 : ENDIF 63 : NSOUPO=1 64 : NC=1 65 : N=NBPOIN 66 : IA=NFI-NDE 67 : DO 10 IAA=1,IA 68 : IRR= NFI-IAA 69 : NAT=1 70 : SEGINI MCHPOI 71 : MOCHDE=' chpoint de coordonnees ' 72 : MTYPOI=' ' 73 : JATTRI(1) = 1 74 : IPPOI=MCHPOI 75 : SEGINI MSOUPO 76 : SEGINI MPOVAL 77 : IPCHP(1)=MSOUPO 78 : IFOPOI = IFOMOD 79 : SEGDES MCHPOI 80 : NOCOMP(1)='SCAL' 81 : NOHARM(1)=NIFOUR 82 : IGEOC=MELEME 83 : IPOVAL=MPOVAL 84 : SEGDES MSOUPO 85 : DO 1 I= 1 ,N 86 : I1=NUM(1,I) 87 : I2=(I1-1)*(IDIM+1) 88 : VPOCHA(I,1)=XCOOR(I2+IRR) 89 : 1 CONTINUE 90 : SEGDES MPOVAL 90 : CALL ECROBJ('CHPOINT ',IPPOI) 91 : 10 CONTINUE 92 : SEGDES MELEME 93 : RETURN 94 : END 95 : 96 :
© Cast3M 2003 - All rights reserved.
Disclaimer