Télécharger trisup.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales