1 : C GENERL SOURCE PV 07/11/23 21:17:05 5978 2 : C EST APPELE PAR GENERATRICE 3 : C 4 : SUBROUTINE GENERL(LP1,LP2,IPT1,MELEME,IDS) 5 : C IDS COULEUR 6 : C IPT1 LIGNE CONNU 7 : C MELEME LIGNE A FABRIQUER 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8 (a-h,o-z) 10 : -INC SMELEME 11 : -INC SMCOORD 12 : -INC CCOPTIO 13 : NBNN=IPT1.NUM(/1) 14 : NBELEM=IPT1.NUM(/2) 15 : NBSOUS=0 16 : NBREF=0 17 : SEGINI MELEME 18 : ITYPEL=IPT1.ITYPEL 19 : NUM(1,1)=LP1 20 : NUM(NBNN,NBELEM)=LP2 21 : IREFPI=(IPT1.NUM(1,1)-1)*(IDIM+1) 22 : XPI=XCOOR(IREFPI+1) 23 : YPI=XCOOR(IREFPI+2) 24 : ZPI=XCOOR(IREFPI+3) 25 : IREFP1=(LP1-1)*(IDIM+1) 26 : XP1=XCOOR(IREFP1+1) 27 : YP1=XCOOR(IREFP1+2) 28 : ZP1=XCOOR(IREFP1+3) 29 : NBPTA=XCOOR(/1)/(IDIM+1) 30 : NBPTS=NBPTA+NBELEM*(NBNN-1) 31 : SEGADJ MCOORD 32 : DO 10 J=1,NBELEM 33 : ICOLOR(J)=IDS 34 : DO 11 I=2,NBNN 35 : IF (I.EQ.NBNN.AND.J.EQ.NBELEM) GOTO 11 36 : IREFPC=(IPT1.NUM(I,J)-1)*(IDIM+1) 37 : XPC=XCOOR(IREFPC+1) 38 : YPC=XCOOR(IREFPC+2) 39 : ZPC=XCOOR(IREFPC+3) 40 : TPC=XCOOR(IREFPC+IDIM+1) 41 : XCOOR(NBPTA*(IDIM+1)+1)=XPC-XPI+XP1 42 : XCOOR(NBPTA*(IDIM+1)+2)=YPC-YPI+YP1 43 : IF (IDIM.EQ.3) XCOOR(NBPTA*(IDIM+1)+3)=ZPC-ZPI+ZP1 44 : XCOOR((NBPTA+1)*(IDIM+1))=TPC 45 : NBPTA=NBPTA+1 46 : NUM(I,J)=NBPTA 47 : 11 CONTINUE 48 : IF (J.EQ.1) GOTO 10 49 : IF (IPT1.NUM(1,J).NE.IPT1.NUM(NBNN,J-1)) THEN 50 : NBPTS=NBPTA 51 : SEGADJ MCOORD 51 : CALL ERREUR(24) 52 : RETURN 53 : ENDIF 54 : NUM(1,J)=NUM(NBNN,J-1) 55 : 10 CONTINUE 56 : NBPTS=NBPTA 57 : SEGADJ MCOORD 58 : RETURN 59 : END 60 : 61 :
© Cast3M 2003 - All rights reserved.
Disclaimer