Télécharger etalpr.eso

Retour à la liste

Numérotation des lignes :

  1. C ETALPR SOURCE CHAT 05/01/12 23:46:07 5004
  2. SUBROUTINE ETALPR(MCHPOI,IINC,ICPR,ICONTR)
  3. C=======================================================================
  4. C CE SUBROUTINE REMPLIT ICPR ,IINC ET ICONTR
  5. C ICPR(K)=IK : LE POINT K EST A LA POSITION IK DANS MCHPOI
  6. C IINC(I) EST LA IEME COMPOSANTE DE MCHPOI(TOUTES LES COMPOSANTES
  7. C DANS IINC SONT DIFFERENTES)
  8. C MCONTR(I,J)=1 VEUT DIRE QUE LA IEME COMPOSANTE DANS IINC EXISTE
  9. C POUR LE IK IEME POINT (TEL QUE ICPR(K)=IK) DANS MCHPOI
  10. C
  11. C ATTENTION SEGINI ICPR. SEGINI IINC. SEGINI ICONTR
  12. C=======================================================================
  13. IMPLICIT INTEGER(I-N)
  14. -INC SMCHPOI
  15. -INC CCOPTIO
  16. -INC SMELEME
  17. -INC SMCOORD
  18. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  19. SEGMENT IINC
  20. CHARACTER*4 CIINC(0)
  21. ENDSEGMENT
  22. SEGMENT /ICONTR/(MCONTR(NNI1,IPR1))
  23. C
  24. SEGINI ICPR
  25. SEGACT MCHPOI
  26. NSOUPO=IPCHP(/1)
  27. IK=0
  28. MSOUPO=IPCHP(1)
  29. SEGACT MSOUPO
  30. SEGINI IINC
  31. CIINC(**)=NOCOMP(1)
  32. SEGDES MSOUPO
  33. ININC=1
  34. DO 101 ISOU=1,NSOUPO
  35. MSOUPO=IPCHP(ISOU)
  36. SEGACT MSOUPO
  37. MELEME=IGEOC
  38. SEGACT MELEME
  39. N2=NUM(/2)
  40. DO 102 I2=1,N2
  41. K=NUM(1,I2)
  42. IK=IK+1
  43. ICPR(K)=IK
  44. 102 CONTINUE
  45. SEGDES MELEME
  46. DO 106 I2=1,NOCOMP(/2)
  47. DO 107 IJ=1,ININC
  48. IF(CIINC(IJ).EQ.NOCOMP(I2)) GO TO 106
  49. 107 CONTINUE
  50. CIINC(**)=NOCOMP(I2)
  51. ININC=ININC+1
  52. 106 CONTINUE
  53. SEGDES MSOUPO
  54. 101 CONTINUE
  55. NNI1=CIINC(/2)
  56. IPR1=IK
  57. SEGINI ICONTR
  58. DO 201 ISOU=1,NSOUPO
  59. MSOUPO=IPCHP(ISOU)
  60. SEGACT MSOUPO
  61. MELEME=IGEOC
  62. SEGACT MELEME
  63. N2=NUM(/2)
  64. NC=NOCOMP(/2)
  65. DO 202 J=1,NC
  66. DO 203 K=1,NNI1
  67. IF(NOCOMP(J).EQ.CIINC(K)) GO TO 204
  68. 203 CONTINUE
  69. 204 CONTINUE
  70. DO 205 I2=1,N2
  71. KI=ICPR(NUM(1,I2))
  72. MCONTR(K,KI)=1
  73. 205 CONTINUE
  74. 202 CONTINUE
  75. SEGDES MELEME,MSOUPO
  76. 201 CONTINUE
  77. SEGDES ICONTR
  78. SEGDES MCHPOI
  79. SEGDES ICPR
  80. SEGDES IINC
  81. RETURN
  82. END
  83.  
  84.  

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