Télécharger pquel.eso

Retour à la liste

Numérotation des lignes :

  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
  15. CALL LIRENT(IMAX,0,IRETOU)
  16. IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
  17. NDEB=IMCT+1
  18. SEGINI XPROJ
  19. SEGACT MCOORD
  20. DO 40 I=INCT,IMCT
  21. II=NFI(I)
  22. NFI(I)=I
  23. IREF=II*(IDIM+1)-IDIM
  24. XPROJ(1,I)=XCOOR(IREF)
  25. XPROJ(2,I)=XCOOR(IREF+1)
  26. XPROJ(3,I)=XCOOR(IREF+IDIM)
  27. IF (IDIM.EQ.3) XPROJ(4,I)=XCOOR(IREF+2)
  28. 40 CONTINUE
  29. C SI LA DENSITE LOCALE N'EST PAS DEFINIE IL FAUT LE FAIRE
  30. DO 41 IT=1,ITOUR
  31. II1=MAI(IT-1+1)+1
  32. II2=MAI(IT+1)
  33. IAP=II2
  34. DO 41 I=II1,II2
  35. IF (XPROJ(3,I).NE.0) GOTO 41
  36. XPROJ(3,I)=SQRT((XPROJ(1,I)-XPROJ(1,IAP))**2+(XPROJ(2,I)-XPROJ(2,
  37. # IAP))**2)
  38. IAP=I
  39. 41 CONTINUE
  40. RETURN
  41. 100 CONTINUE
  42. C ON RECONSTITUE LE MAILLAGE
  43. SEGACT MCOORD
  44. IF (NDEB.GT.NUMNP) GOTO 111
  45. NBPTA=XCOOR(/1)/(IDIM+1)
  46. NBPTS=NBPTA+NUMNP-NDEB+1
  47. SEGADJ MCOORD
  48. DO 110 I=NDEB,NUMNP
  49. XCOOR(NBPTA*(IDIM+1)+1)=XPROJ(1,I)
  50. XCOOR(NBPTA*(IDIM+1)+2)=XPROJ(2,I)
  51. XCOOR((NBPTA+1)*(IDIM+1))=XPROJ(3,I)
  52. IF (IDIM.GE.3)
  53. #XCOOR(NBPTA*(IDIM+1)+3)=XPROJ(4,I)
  54. NBPTA=NBPTA+1
  55. 110 CONTINUE
  56. 111 CONTINUE
  57. SEGSUP XPROJ
  58. RETURN
  59. END
  60.  
  61.  

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