Télécharger pplan.eso

Retour à la liste

Numérotation des lignes :

  1. C PPLAN SOURCE PV 20/03/24 21:20:16 10554
  2. C CE SOUS-PROGRAMME RAMENE UN PLAN SUR DES COORDONNEES INTRINSEQUES
  3. C
  4. SUBROUTINE PPLAN(IOP,FER,XPROJ,NDEB,NUMNP,tcval)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMCOORD
  11. real*8 tcval(*)
  12. SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER
  13. SEGMENT XPROJ(3,IMAX)
  14. * tcval (1) 2 3 4 5 6
  15. * COMMON/CPPLAN/XVEC1,YVEC1,ZVEC1,XVEC2,YVEC2,ZVEC2,XNORM,YNORM,
  16. *
  17. * # ZNORM
  18. * 7 8 9
  19. * SAVE XGRAV,YGRAV,ZGRAV
  20. IF (IOP.EQ.2) GOTO 100
  21. ctest=1d-2
  22. if (idim.eq.3) call lirree(ctest,0,iretou)
  23. IMCT=MAI(ITOUR+1)
  24. INCT=MAI(1)+1
  25. IMAX=(IMCT**2)+10
  26. CALL LIRENT(IMAX,0,IRETOU)
  27. IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
  28. NDEB=IMCT+1
  29. SEGINI XPROJ
  30. SEGACT MCOORD*mod
  31. C CENTRE DE GRAVITE
  32. XGRAV=0
  33. YGRAV=0
  34. ZGRAV=0
  35. DO 1 I=INCT,IMCT
  36. IREF=(NFI(I))*(IDIM+1)-IDIM
  37. XGRAV=XGRAV+XCOOR(IREF)
  38. YGRAV=YGRAV+XCOOR(IREF+1)
  39. ZGRAV=ZGRAV+XCOOR(IREF+2)
  40. 1 CONTINUE
  41. XGRAV=XGRAV/(IMCT-INCT+1)
  42. YGRAV=YGRAV/(IMCT-INCT+1)
  43. ZGRAV=ZGRAV/(IMCT-INCT+1)
  44. IF (IDIM.EQ.2) ZGRAV=0
  45. tcval(7)=xgrav
  46. tcval(8)=ygrav
  47. tcval(9)=zgrav
  48. C VECTEUR NORMAL
  49. XNORM=0
  50. YNORM=0
  51. ZNORM=0
  52. DO 2 IT=1,ITOUR
  53. IPR=NFI(MAI(IT+1))*(IDIM+1)-IDIM
  54. XV1=XCOOR(IPR)-XGRAV
  55. YV1=XCOOR(IPR+1)-YGRAV
  56. ZV1=XCOOR(IPR+2)-ZGRAV
  57. IF (IDIM.EQ.2) ZV1=0
  58. DO 2 I=MAI(IT-1+1)+1,MAI(IT+1)
  59. IREF=(NFI(I))*(IDIM+1)-IDIM
  60. XV2=XCOOR(IREF)-XGRAV
  61. YV2=XCOOR(IREF+1)-YGRAV
  62. ZV2=0
  63. IF (IDIM.GE.3) ZV2=XCOOR(IREF+2)-ZGRAV
  64. XNORM=XNORM+YV1*ZV2-ZV1*YV2
  65. YNORM=YNORM+ZV1*XV2-XV1*ZV2
  66. ZNORM=ZNORM+XV1*YV2-XV2*YV1
  67. XV1=XV2
  68. YV1=YV2
  69. ZV1=ZV2
  70. 2 CONTINUE
  71. DNORM=SQRT(XNORM**2+YNORM**2+ZNORM**2)
  72. IF (DNORM.EQ.0.) CALL ERREUR(21)
  73. IF (IERR.NE.0) RETURN
  74. XNORM=XNORM/DNORM
  75. YNORM=YNORM/DNORM
  76. ZNORM=ZNORM/DNORM
  77. C FORMATION DU REPERE
  78. IREF=NFI(INCT)*(IDIM+1)-IDIM
  79. XVEC1=XCOOR(IREF)-XGRAV
  80. YVEC1=XCOOR(IREF+1)-YGRAV
  81. ZVEC1=0
  82. IF (IDIM.GE.3) ZVEC1=XCOOR(IREF+2)-ZGRAV
  83. PVEC=XVEC1*XNORM+YVEC1*YNORM+ZVEC1*ZNORM
  84. XVEC1=XVEC1-PVEC*XNORM
  85. YVEC1=YVEC1-PVEC*YNORM
  86. ZVEC1=ZVEC1-PVEC*ZNORM
  87. DVEC1=XVEC1**2+YVEC1**2+ZVEC1**2
  88. DVEC1=SQRT(DVEC1)
  89. XVEC1=XVEC1/DVEC1
  90. YVEC1=YVEC1/DVEC1
  91. ZVEC1=ZVEC1/DVEC1
  92. tcval(1)=xvec1
  93. tcval(2)=yvec1
  94. tcval(3)=zvec1
  95. XVEC2=YNORM*ZVEC1-ZNORM*YVEC1
  96. YVEC2=ZNORM*XVEC1-XNORM*ZVEC1
  97. ZVEC2=XNORM*YVEC1-YNORM*XVEC1
  98. tcval(4)=xvec2
  99. tcval(5)=yvec2
  100. tcval(6)=zvec2
  101. C EN AVANT POUR LA PROJECTION
  102. DO 40 I=INCT,max(IMCT,mai(itour+2))
  103. II=NFI(I)
  104. NFI(I)=I
  105. IREF=II*(IDIM+1)-IDIM
  106. XRE=XCOOR(IREF)-XGRAV
  107. YRE=XCOOR(IREF+1)-YGRAV
  108. ZRE=XCOOR(IREF+2)-ZGRAV
  109. if (idim.eq.2) zre=0
  110. XPROJ(1,I)=XRE*XVEC1+YRE*YVEC1+ZRE*ZVEC1
  111. XPROJ(2,I)=XRE*XVEC2+YRE*YVEC2+ZRE*ZVEC2
  112. XTEST =XRE*XNORM+YRE*YNORM+ZRE*ZNORM
  113. DRE =SQRT(XRE*XRE+YRE*YRE+ZRE*ZRE)
  114. IF (IDIM.EQ.3.AND.ABS(XTEST).GT.DRE*ctest.AND.
  115. # i.le.imct) CALL ERREUR(26)
  116. IF (IERR.NE.0) RETURN
  117. XPROJ(3,I)=XCOOR(IREF+IDIM)
  118. 40 CONTINUE
  119. C SI LA DENSITE LOCALE N'EST PAS DEFINIE IL FAUT LE FAIRE
  120. DO 41 IT=1,ITOUR
  121. II1=MAI(IT-1+1)+1
  122. II2=MAI(IT+1)
  123. IAP=II2
  124. DO 41 I=II1,II2
  125. IF (XPROJ(3,I).NE.0) GOTO 41
  126. XPROJ(3,I)=SQRT((XPROJ(1,I)-XPROJ(1,IAP))**2+(XPROJ(2,I)-XPROJ(2,
  127. # IAP))**2)
  128. IAP=I
  129. 41 CONTINUE
  130. RETURN
  131. 100 CONTINUE
  132. xvec1=tcval(1)
  133. yvec1=tcval(2)
  134. zvec1=tcval(3)
  135. xvec2=tcval(4)
  136. yvec2=tcval(5)
  137. zvec2=tcval(6)
  138. xgrav=tcval(7)
  139. ygrav=tcval(8)
  140. zgrav=tcval(9)
  141. C ON RECONSTITUE LE MAILLAGE
  142. SEGACT MCOORD*mod
  143. IF (NDEB.GT.NUMNP) GOTO 111
  144. NBPTA=nbpts
  145. NBPTS=NBPTA+NUMNP-NDEB+1
  146. SEGADJ MCOORD
  147. DO 110 I=NDEB,NUMNP
  148. XCOOR(NBPTA*(IDIM+1)+1)=XPROJ(1,I)*XVEC1+XPROJ(2,I)*XVEC2+XGRAV
  149. XCOOR(NBPTA*(IDIM+1)+2)=XPROJ(1,I)*YVEC1+XPROJ(2,I)*YVEC2+YGRAV
  150. IF (IDIM.GE.3)
  151. #XCOOR(NBPTA*(IDIM+1)+3)=XPROJ(1,I)*ZVEC1+XPROJ(2,I)*ZVEC2+ZGRAV
  152. XCOOR((NBPTA+1)*(IDIM+1))=XPROJ(3,I)
  153. NBPTA=NBPTA+1
  154. 110 CONTINUE
  155. 111 CONTINUE
  156. SEGSUP XPROJ
  157. RETURN
  158. END
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  

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