Télécharger etalpr.eso

Retour à la liste

Numérotation des lignes :

  1. C ETALPR SOURCE CB215821 19/08/20 21:17:13 10287
  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. NSOUPO=IPCHP(/1)
  26. IK=0
  27. MSOUPO=IPCHP(1)
  28. SEGINI IINC
  29. CIINC(**)=NOCOMP(1)
  30. ININC=1
  31.  
  32. DO 101 ISOU=1,NSOUPO
  33. MSOUPO=IPCHP(ISOU)
  34. MELEME=IGEOC
  35. N2=NUM(/2)
  36. DO 102 I2=1,N2
  37. K=NUM(1,I2)
  38. IK=IK+1
  39. ICPR(K)=IK
  40. 102 CONTINUE
  41. DO 106 I2=1,NOCOMP(/2)
  42. DO 107 IJ=1,ININC
  43. IF(CIINC(IJ).EQ.NOCOMP(I2)) GO TO 106
  44. 107 CONTINUE
  45. CIINC(**)=NOCOMP(I2)
  46. ININC=ININC+1
  47. 106 CONTINUE
  48. 101 CONTINUE
  49.  
  50. NNI1=CIINC(/2)
  51. IPR1=IK
  52. SEGINI ICONTR
  53. DO 201 ISOU=1,NSOUPO
  54. MSOUPO=IPCHP(ISOU)
  55. MELEME=IGEOC
  56. N2=NUM(/2)
  57. NC=NOCOMP(/2)
  58. DO 202 J=1,NC
  59. DO 203 K=1,NNI1
  60. IF(NOCOMP(J).EQ.CIINC(K)) GO TO 204
  61. 203 CONTINUE
  62. 204 CONTINUE
  63. DO 205 I2=1,N2
  64. KI=ICPR(NUM(1,I2))
  65. MCONTR(K,KI)=1
  66. 205 CONTINUE
  67. 202 CONTINUE
  68. 201 CONTINUE
  69. END
  70.  
  71.  
  72.  
  73.  

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