1 : C TRISUP SOURCE CHAT 10/09/28 21:15:08 6767 2 : C ISSUS DE COCO SUPER TRI 3 : C 4 : SUBROUTINE TRISUP(NUMNP,PREC,NG,TRUC,TRUC1,CRIT,XMIN,YMIN,ZMIN, 5 : # STRAV) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : -INC CCOPTIO 9 : -INC SMCOORD 10 : SEGMENT /STRAV/(NP1(ITE),NP2(ITE),NP3(ITE),NPI(ITE),IDCP(ITE)) 11 : INTEGER TRUC,TRUC1,TRUC2,TRUC3 12 : IDIMP1=IDIM+1 13 : NF=3 14 : NUMNP3=NUMNP+3+1 15 : ANF=NF*NUMNP 16 : IREF=IDCP(1)*IDIMP1-IDIM 17 : XMAX=XCOOR(IREF) 18 : XMIN=XMAX 19 : IF (IDIM.EQ.3) THEN 20 : YMAX=XCOOR(IREF+1) 21 : YMIN=YMAX 22 : ZMAX=XCOOR(IREF+2) 23 : ZMIN=ZMAX 24 : DO 13 I=2,NUMNP 25 : IREF=IDCP(I)*IDIMP1-IDIM 26 : ZZ=XCOOR(IREF) 27 : XMIN=MIN(XMIN,ZZ) 28 : XMAX=MAX(XMAX,ZZ) 29 : ZZ=XCOOR(IREF+1) 30 : YMIN=MIN(YMIN,ZZ) 31 : YMAX=MAX(YMAX,ZZ) 32 : ZZ=XCOOR(IREF+2) 33 : ZMIN=MIN(ZMIN,ZZ) 34 : ZMAX=MAX(ZMAX,ZZ) 35 : 13 CONTINUE 36 : ELSE IF (IDIM.EQ.2) THEN 37 : YMAX=XCOOR(IREF+1) 38 : YMIN=YMAX 39 : DO 12 I=2,NUMNP 40 : IREF=IDCP(I)*IDIMP1-IDIM 41 : ZZ=XCOOR(IREF) 42 : XMIN=MIN(XMIN,ZZ) 43 : XMAX=MAX(XMAX,ZZ) 44 : ZZ=XCOOR(IREF+1) 45 : YMIN=MIN(YMIN,ZZ) 46 : YMAX=MAX(YMAX,ZZ) 47 : 12 CONTINUE 48 : ZMIN=0.D0 49 : ZMAX=0.D0 50 : C* ELSE IF (IDIM.EQ.1) THEN 51 : ELSE 52 : DO 11 I=2,NUMNP 53 : IREF=IDCP(I)*IDIMP1-IDIM 54 : ZZ=XCOOR(IREF) 55 : XMIN=MIN(XMIN,ZZ) 56 : XMAX=MAX(XMAX,ZZ) 57 : 11 CONTINUE 58 : YMIN=0.D0 59 : YMAX=0.D0 60 : ZMIN=0.D0 61 : ZMAX=0.D0 62 : ENDIF 63 : DISTZA=(XMAX-XMIN)/PREC 64 : DISTZB=(YMAX-YMIN)/PREC 65 : DISTZC=(ZMAX-ZMIN)/PREC 66 : A=(DISTZA+1)*(DISTZB+1)*(DISTZC+1) 67 : RAP=1.D0 68 : IF (A.GT.ANF) RAP=(ANF/A)**(1.D0/3.D0) 69 : TRUC =INT(DISTZA*RAP)+3 70 : TRUC1=INT(DISTZB*RAP)+3 71 : TRUC2=INT(DISTZC*RAP)+3 72 : TRUC3=TRUC*TRUC1 73 : CRIT=PREC/RAP*1.0001D0 74 : NG=TRUC3*TRUC2/NUMNP+1 75 : DO 20 I=1,NUMNP3 76 : NP1(I)=0 77 : 20 CONTINUE 78 : YCOR=0.D0 79 : ZCOR=0.D0 80 : DO 25 I=1,NUMNP 81 : IREF=IDCP(I)*IDIMP1-IDIM 82 : IF (IDIM.GE.2) YCOR=XCOOR(IREF+1) 83 : IF (IDIM.GE.3) ZCOR=XCOOR(IREF+2) 84 : ICRAT= INT((XCOOR(IREF)-XMIN)/CRIT+2) 85 : . +INT((YCOR-YMIN)/CRIT+1)*TRUC 86 : . +INT((ZCOR-ZMIN)/CRIT+1)*TRUC3 87 : NZONE=ICRAT/NG+1 88 : NP1(NZONE)=NP1(NZONE)+1 89 : 25 CONTINUE 90 : DO 30 I=2,NUMNP3 91 : NP1(I)=NP1(I-1)+NP1(I) 92 : 30 CONTINUE 93 : DO 35 I=1,NUMNP 94 : IREF=IDCP(I)*IDIMP1-IDIM 95 : IF (IDIM.GE.2) YCOR=XCOOR(IREF+1) 96 : IF (IDIM.GE.3) ZCOR=XCOOR(IREF+2) 97 : ICRAT= INT((XCOOR(IREF)-XMIN)/CRIT+2) 98 : . +INT((YCOR-YMIN)/CRIT+1)*TRUC 99 : . +INT((ZCOR-ZMIN)/CRIT+1)*TRUC3 100 : NZONE=ICRAT/NG+1 101 : J=NP1(NZONE) 102 : NP3(J)=ICRAT 103 : NP2(J)=I 104 : NP1(NZONE)=NP1(NZONE)-1 105 : 35 CONTINUE 106 : DO 40 I=1,NUMNP3-1 107 : JD=NP1(I)+2 108 : JF=NP1(I+1) 109 : IF (JD.LE.JF) THEN 110 : 45 IPERM=0 111 : DO 50 J=JD,JF 112 : IF (NP3(J-1).GT.NP3(J)) THEN 113 : L1=NP2(J-1) 114 : NP2(J-1)=NP2(J) 115 : NP2(J)=L1 116 : L1=NP3(J-1) 117 : NP3(J-1)=NP3(J) 118 : NP3(J)=L1 119 : IPERM=1 120 : ENDIF 121 : 50 CONTINUE 122 : IF (IPERM.EQ.1) GO TO 45 123 : ENDIF 124 : 40 CONTINUE 125 : IF (IIMPI.NE.0) WRITE (IOIMP,41) DISTZA,DISTZB,DISTZC 126 : 41 FORMAT (1X,' DISTZA=',F10.3,'DISTZB=',F10.3,'DISTZC=',F10.3) 127 : RETURN 128 : END 129 : 130 : 131 : 132 :
© Cast3M 2003 - All rights reserved.
Disclaimer