Télécharger trachp.eso

Retour à la liste

Numérotation des lignes :

  1. C TRACHP SOURCE CB215821 19/08/20 21:22:32 10287
  2. SUBROUTINE TRACHP(MCHPOI,MTRAV)
  3. *
  4. * MET UN CHAMP POINT SOUS FORME DE TRAVAIL
  5. *
  6. IMPLICIT INTEGER(I-N)
  7. -INC SMCOORD
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC SMCHPOI
  12. -INC SMELEME
  13. -INC TMTRAV
  14. SEGMENT ITRAV
  15. CHARACTER*4 INC(NN)
  16. INTEGER IHAR(NN)
  17. ENDSEGMENT
  18. NN = 0
  19. SEGACT MCHPOI
  20. *
  21. * ON ACTIVE TOUS LES SEGMENTS MSOUPO
  22. *
  23. DO 1 I=1,IPCHP(/1)
  24. MSOUPO=IPCHP(I)
  25. SEGACT MSOUPO
  26. NN = NN + NOCOMP(/2)
  27. 1 CONTINUE
  28. *
  29. * CREATION DE ITRAV ET REMPLISSAGE
  30. *
  31. NNNOE=0
  32. SEGINI ITRAV
  33. NNIN=0
  34. DO 2 I=1,IPCHP(/1)
  35. MSOUPO=IPCHP(I)
  36. DO 3 J=1,NOCOMP(/2)
  37. DO 4 K=1,NNIN
  38. IF(INC(K).NE.NOCOMP(J)) GO TO 4
  39. IF(IHAR(K).EQ.NOHARM(J)) GO TO 3
  40. 4 CONTINUE
  41. NNIN=NNIN+1
  42. INC(NNIN)=NOCOMP(J)
  43. IHAR(NNIN)=NOHARM(J)
  44. 3 CONTINUE
  45. MELEME=IGEOC
  46. SEGACT MELEME
  47. NNNOE=NNNOE+NUM(/2)
  48. 2 CONTINUE
  49. *
  50. * CREATION DE MTRAV ET REMPLISSAGE
  51. *
  52. NDEJ=0
  53. SEGINI MTRAV
  54. DO 7 I=1,IPCHP(/1)
  55. MSOUPO=IPCHP(I)
  56. MPOVAL=IPOVAL
  57. SEGACT MPOVAL
  58. DO 8 J=1,NOCOMP(/2)
  59. DO 9 K=1,NNIN
  60. IF(NOCOMP(J).NE.INC(K)) GO TO 9
  61. IF(NOHARM(J).EQ.IHAR(K)) GO TO 10
  62. 9 CONTINUE
  63. CALL ERREUR (5)
  64. 10 CONTINUE
  65. KK=K
  66. MELEME=IGEOC
  67. DO 11 K=1,NUM(/2)
  68. BB(KK,K+NDEJ)=VPOCHA(K,J)
  69. IBIN(KK,K+NDEJ)=1
  70. IGEO(K+NDEJ)=NUM(1,K)
  71. 11 CONTINUE
  72. 8 CONTINUE
  73. NDEJ=NDEJ+NUM(/2)
  74. 7 CONTINUE
  75. DO 13 I=1,NNIN
  76. INCO(I)=INC(I)
  77. NHAR(I)=IHAR(I)
  78. 13 CONTINUE
  79. * WRITE(6,30) (INCO(I),I=1,NNIN)
  80. * WRITE(6,31) (NHAR(I),I=1,NNIN)
  81. * WRITE(6,32) (( IBIN(I,J),I=1,NNIN),J=1,NNNOE)
  82. * WRITE(6,33) (( BB(I,J),I=1,NNIN),J=1,NNNOE)
  83. * WRITE(6,36) ( IGEO(I),I=1,NNNOE)
  84. * 36 FORMAT(' IGEO ', /,(20I4))
  85. * 30 FORMAT(' INCO ', 6A6)
  86. * 31 FORMAT(' NHAR ', 6I6)
  87. * 32 FORMAT(' IBIN ',/,(20I4))
  88. * 33 FORMAT(' BB ',/,(1X,6E12.5))
  89. SEGSUP ITRAV
  90. END
  91.  
  92.  
  93.  

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