1 : C PQUEL SOURCE CHAT 05/01/13 02:21:02 5004 2 : C CE SOUS-PROGRAMME RAMENE UN PLAN SUR DES COORDONNEES INTRINSEQUES 3 : C 4 : SUBROUTINE PQUEL(IOP,FER,XPROJ,NDEB,NUMNP) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : -INC CCOPTIO 8 : -INC SMCOORD 9 : SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER 10 : SEGMENT XPROJ(IDIM+1,IMAX) 11 : IF (IOP.EQ.2) GOTO 100 12 : IMCT=MAI(ITOUR+1) 13 : INCT=MAI(1)+1 14 : IMAX=(IMCT**2)/5+10 14 : CALL LIRENT(IMAX,0,IRETOU) 15 : IF (IRETOU.NE.0) IMAX=MAX(1,IMAX) 16 : NDEB=IMCT+1 17 : SEGINI XPROJ 18 : SEGACT MCOORD 19 : DO 40 I=INCT,IMCT 20 : II=NFI(I) 21 : NFI(I)=I 22 : IREF=II*(IDIM+1)-IDIM 23 : XPROJ(1,I)=XCOOR(IREF) 24 : XPROJ(2,I)=XCOOR(IREF+1) 25 : XPROJ(3,I)=XCOOR(IREF+IDIM) 26 : IF (IDIM.EQ.3) XPROJ(4,I)=XCOOR(IREF+2) 27 : 40 CONTINUE 28 : C SI LA DENSITE LOCALE N'EST PAS DEFINIE IL FAUT LE FAIRE 29 : DO 41 IT=1,ITOUR 30 : II1=MAI(IT-1+1)+1 31 : II2=MAI(IT+1) 32 : IAP=II2 33 : DO 41 I=II1,II2 34 : IF (XPROJ(3,I).NE.0) GOTO 41 35 : XPROJ(3,I)=SQRT((XPROJ(1,I)-XPROJ(1,IAP))**2+(XPROJ(2,I)-XPROJ(2, 36 : # IAP))**2) 37 : IAP=I 38 : 41 CONTINUE 39 : RETURN 40 : 100 CONTINUE 41 : C ON RECONSTITUE LE MAILLAGE 42 : SEGACT MCOORD 43 : IF (NDEB.GT.NUMNP) GOTO 111 44 : NBPTA=XCOOR(/1)/(IDIM+1) 45 : NBPTS=NBPTA+NUMNP-NDEB+1 46 : SEGADJ MCOORD 47 : DO 110 I=NDEB,NUMNP 48 : XCOOR(NBPTA*(IDIM+1)+1)=XPROJ(1,I) 49 : XCOOR(NBPTA*(IDIM+1)+2)=XPROJ(2,I) 50 : XCOOR((NBPTA+1)*(IDIM+1))=XPROJ(3,I) 51 : IF (IDIM.GE.3) 52 : #XCOOR(NBPTA*(IDIM+1)+3)=XPROJ(4,I) 53 : NBPTA=NBPTA+1 54 : 110 CONTINUE 55 : 111 CONTINUE 56 : SEGSUP XPROJ 57 : RETURN 58 : END 59 :
© Cast3M 2003 - All rights reserved.
Disclaimer