Télécharger evol1.eso

Retour à la liste

Numérotation des lignes :

  1. C EVOL1 SOURCE CHAT 05/01/12 23:47:03 5004
  2. SUBROUTINE EVOL1(IBOO,ILEX)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C SOUS-PROGRAMME APPELE PAR EVOLL1
  7. C FABRIQUE LE(S) LISTREEL KLIST A PARTIR DE LA SUITE DES CHAMPOINTS
  8. C CONTENUE DANS LE SEGMENT MLENTIPOINTE PAR ILEX
  9. C
  10. C
  11. C CREATION : 16/10/85
  12. C PROGRAMMEUR : FARVACQUE
  13. C=======================================================================
  14. C
  15. -INC CCOPTIO
  16. -INC SMCHPOI
  17. -INC SMLENTI
  18. -INC SMLREEL
  19. -INC SMELEME
  20. SEGMENT NUMOO
  21. INTEGER NUMO(N),KLIST(N)
  22. CHARACTER*4 NUDDL(N)
  23. ENDSEGMENT
  24. SEGMENT/ITRAV/(NBB(N),ICC(N),ISS(N))
  25. CHARACTER*4 NUJ
  26. C
  27. NUMOO=IBOO
  28. SEGACT NUMOO*MOD
  29. N=NUMO(/1)
  30. SEGINI ITRAV
  31. MLENTI=ILEX
  32. SEGACT MLENTI
  33. LTEM=LECT(/1)
  34. ISS=0
  35. C
  36. C *** PREMIER PASSAGE ON REPERE LE CHAMP ISS ICC NBB
  37. C
  38. MCHPOI=LECT (1)
  39. SEGACT MCHPOI
  40. NSOUPO=IPCHP(/1)
  41. KK=0
  42. DO 70 ISOU=1,NSOUPO
  43. MSOUPO=IPCHP(ISOU)
  44. SEGACT MSOUPO
  45. NC=NOCOMP(/2)
  46. MELEME=IGEOC
  47. SEGACT MELEME
  48. NBELEM=NUM(/2)
  49. DO 60 NB=1,NBELEM
  50. J=NUM(1,NB)
  51. DO 71 JJ=1,N
  52. IF(J.EQ.NUMO(JJ)) THEN
  53. NBB(JJ)=NB
  54. KK=KK+1
  55. NUJ=NUDDL(JJ)
  56. DO 72 IC=1,NC
  57. IF(NOCOMP(IC).EQ.NUJ) THEN
  58. ICC(JJ)=IC
  59. ISS(JJ)=ISOU
  60. GOTO 71
  61. ENDIF
  62. 72 CONTINUE
  63. MOTERR(1:4)=NUJ
  64. CALL ERREUR(243)
  65. C INCOMPATIBILITE ENTRE LA COMPOSANTE ET LE POINT
  66. GOTO 5000
  67. ENDIF
  68. 71 CONTINUE
  69. IF(KK.EQ.N) THEN
  70. SEGDES MELEME,MSOUPO
  71. GOTO 61
  72. ENDIF
  73. 60 CONTINUE
  74. SEGDES MELEME,MSOUPO
  75. 70 CONTINUE
  76. C
  77. INTERR(1)=J
  78. MOTERR(1:8)='CHPOINT'
  79. CALL ERREUR(64)
  80. C DES POINT N'APPARTIENNENT PAS AU CHAMP
  81. GOTO 5000
  82. C
  83. C ****** BOUCLE SUR LES CHPOINTS***************************
  84. C
  85. 61 CONTINUE
  86. JG=LTEM
  87. DO 99 JJ=1,N
  88. SEGINI MLREEL
  89. KLIST(JJ)=MLREEL
  90. 99 CONTINUE
  91. C
  92. DO 90 L=1,LTEM
  93. MCHPOI=LECT (L)
  94. SEGACT MCHPOI
  95. DO 40 JJ=1,N
  96. MSOUPO=IPCHP(ISS(JJ))
  97. SEGACT MSOUPO
  98. MPOVAL=IPOVAL
  99. SEGACT MPOVAL
  100. MLREEL=KLIST(JJ)
  101. PROG(L)=VPOCHA(NBB(JJ),ICC(JJ))
  102. SEGDES MPOVAL,MSOUPO
  103. 40 CONTINUE
  104. SEGDES MCHPOI
  105. 90 CONTINUE
  106. C
  107. SEGSUP ITRAV
  108. DO 98 JJ=1,N
  109. MLREEL=KLIST(JJ)
  110. SEGDES MLREEL
  111. 98 CONTINUE
  112. C
  113. SEGSUP MLENTI
  114. 5000 CONTINUE
  115. RETURN
  116. END
  117.  
  118.  
  119.  

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