Télécharger la plaquette Cast3M


fr en

Télécharger concat.eso

Retour à la liste

Numérotation des lignes : 

concat

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

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