Télécharger fuevol.eso

Retour à la liste

Numérotation des lignes :

  1. C FUEVOL SOURCE BP208322 14/04/03 21:15:01 8017
  2. SUBROUTINE FUEVOL(IBO1,IBO2,IRET)
  3. C
  4. C ==================================================================
  5. C = FUSION DE 2 OBJETS EVOLUTION MEVOL1 ET MEVOL2 =
  6. C = LE RESULTAT EST RANGE DANS MEVOLL =
  7. C = SOUS-PROGRAMME APPELE PAR PRFUSE (OPERATEUR ET ) =
  8. C = CREATION : 01/10/86 =
  9. C = PROGRAMMEUR : GUILBAUD =
  10. C = BP, 2014-04-02 : ajout de ITYEVO =
  11. C ==================================================================
  12. C
  13. IMPLICIT INTEGER(I-N)
  14. -INC CCOPTIO
  15. -INC SMEVOLL
  16. C
  17. CHARACTER *72 TI
  18. MEVOL1=IBO1
  19. MEVOL2=IBO2
  20. SEGACT MEVOL1,MEVOL2
  21. N1=MEVOL1.IEVOLL(/1)
  22. N2=MEVOL2.IEVOLL(/1)
  23. N=N1+N2
  24. SEGINI MEVOLL
  25. IRET=MEVOLL
  26. IF(MEVOL1.ITYEVO .EQ. MEVOL2.ITYEVO) THEN
  27. ITYEVO = MEVOL1.ITYEVO
  28. ELSEIF(MEVOL2.ITYEVO .EQ. ' ') THEN
  29. ITYEVO = MEVOL1.ITYEVO
  30. ELSEIF(MEVOL1.ITYEVO .EQ. ' ') THEN
  31. ITYEVO = MEVOL2.ITYEVO
  32. ELSE
  33. c ITYEVO='REEL'
  34. ITYEVO=' '
  35. ENDIF
  36. TI(1:72)=TITREE
  37. IEVTEX=TI
  38. DO 3 I=1,N1
  39. IEVOLL(I)=MEVOL1.IEVOLL(I)
  40. 3 CONTINUE
  41. DO 4 J=1,N2
  42. I=N1+J
  43. IEVOLL(I)=MEVOL2.IEVOLL(J)
  44. 4 CONTINUE
  45. SEGDES MEVOLL
  46. SEGDES MEVOL1
  47. SEGDES MEVOL2
  48. RETURN
  49. END
  50.  
  51.  
  52.  

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