Télécharger concat.eso

Retour à la liste

Numérotation des lignes :

  1. C CONCAT SOURCE BP208322 15/05/11 21:15:04 8528
  2. SUBROUTINE CONCAT
  3. C
  4. C ==================================================================
  5. C = CONCATENATION DE 2 OBJETS EVOLUTION MEVOL1 ET MEVOL2 =
  6. C = LE RESULTAT EST RANGE DANS MEVOLL =
  7. C = =
  8. C = APPEL DU SOUS-PROGRAMME FUSPRO =
  9. C ==================================================================
  10. C
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT real*8 (a-h,o-z)
  13. -INC CCOPTIO
  14. -INC SMEVOLL
  15. -INC SMLREEL
  16. C
  17. CHARACTER*8 ITEVOL,ITCOUR
  18. DATA ITEVOL,ITCOUR/'EVOLUTIO','COURBES '/
  19. C
  20. CALL LIROBJ('EVOLUTIO',IR1,1,IRETOU)
  21. IF(IERR.NE.0)RETURN
  22. CALL LIROBJ('EVOLUTIO',IR2,1,IRETOU)
  23. IF(IERR.NE.0)RETURN
  24. C
  25. MEVOL1=IR1
  26. MEVOL2=IR2
  27. SEGACT MEVOL1,MEVOL2
  28. N1=MEVOL1.IEVOLL(/1)
  29. N2=MEVOL2.IEVOLL(/1)
  30. C LES MEVOL DOIVENT AVOIR LE MEME NOMBRE DE COURBES
  31. IF(N1.NE.N2) THEN
  32. MOTERR(1:8)=ITEVOL(1:8)
  33. MOTERR(9:16)=ITCOUR(1:8)
  34. CALL ERREUR(403)
  35. RETURN
  36. ENDIF
  37. C
  38. N=N1
  39. SEGINI MEVOLL
  40. IRET=MEVOLL
  41. ITYEVO=MEVOL1.ITYEVO
  42. IEVTEX=TITREE
  43. C
  44. C
  45. DO 1 IC=1,N1
  46. C INITIALISATION DU MEVOL RESULTAT
  47. SEGINI KEVOLL
  48. IEVOLL(IC)=KEVOLL
  49. TYPX='LISTREEL'
  50. TYPY='LISTREEL'
  51. c KEVTEX=TITREE(1:72)
  52. C
  53. KEVOL1=MEVOL1.IEVOLL(IC)
  54. KEVOL2=MEVOL2.IEVOLL(IC)
  55. SEGACT KEVOL1,KEVOL2
  56. KEVTEX=KEVOL1.KEVTEX
  57. NOMEVX=KEVOL1.NOMEVX
  58. NOMEVY=KEVOL1.NOMEVY
  59. NUMEVX=KEVOL1.NUMEVX
  60. NUMEVY=KEVOL1.NUMEVY
  61. MLREE1=KEVOL1.IPROGX
  62. MLREE2=KEVOL2.IPROGX
  63. SEGACT MLREE1,MLREE2
  64. C
  65. IL1=MLREE1
  66. IL2=MLREE2
  67. V1=MLREE1.PROG(1)
  68. V2=MLREE2.PROG(1)
  69. C ACTIVATION DE MLREE1 ET MLREE2 DANS FUSPRO
  70. SEGDES MLREE1,MLREE2
  71. IF(V2.GE.V1) THEN
  72. CALL FUSPRO(IL1,IL2,IRETOU)
  73. ELSE
  74. CALL FUSPRO(IL2,IL1,IRETOU)
  75. ENDIF
  76. IPROGX=IRETOU
  77. C
  78. C
  79. MLREE1=KEVOL1.IPROGY
  80. MLREE2=KEVOL2.IPROGY
  81. IL1=MLREE1
  82. IL2=MLREE2
  83. IF(V2.GE.V1) THEN
  84. CALL FUSPRO(IL1,IL2,IRETOU)
  85. ELSE
  86. CALL FUSPRO(IL2,IL1,IRETOU)
  87. ENDIF
  88. IPROGY=IRETOU
  89. SEGDES KEVOL1,KEVOL2
  90. C
  91. C
  92. SEGDES KEVOLL
  93. 1 CONTINUE
  94. C
  95. C
  96. SEGDES MEVOLL
  97. SEGDES MEVOL1,MEVOL2
  98. CALL ECROBJ('EVOLUTIO',IRET)
  99. RETURN
  100. END
  101.  
  102.  
  103.  
  104.  

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