Télécharger la plaquette Cast3M


fr en

Télécharger adevo.eso

Retour à la liste

Numérotation des lignes : 

adevo

  1. C ADEVO     SOURCE    BP208322  15/05/11    21:15:00     8528
  2.       SUBROUTINE ADEVO(IPEV1,IPEV2,IRET,INV)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C   =                                                                  =
  8. C   =      APPELE PAR ADEVOL                                           =
  9. C   =                                                                  =
  10. C   = CONSTRUCTION D'UN OBJET DE TYPE EVOL CONTENANT LA SOMME OU LA    =
  11. C   = DIFFERENCE TERME A TERME DE DEUX OBJETS EVOLUTION                =
  12. C   =                  DE MEMES ABSCISSES                              =
  13. C   =                                                                  =
  14. C   = SYNTAXE : PROD =  EVOLF + EVOLV                                  =
  15. C   =                                                                  =
  16. C   = ON EXECUTE LA SOMME TERME A TERME DES ORDONNEES DES DEUX         =
  17. C   = OBJETS DE TYPE EVOLUTIO EVOLF ET EVOLV. LES ABSCISSES DE PROD,   =
  18. C   = L'OBJET AINSI CREE, RESTENT CELLES DE EVOLF ET EVOLV.            =
  19. C   =                                                                  =
  20. C   =                                                                  =
  21. C   =                                                                  =
  22. C   =   MEVOL1  :  POINTEUR SUR MEVOLF (OBJET EVOLUTION)               =
  23. C   =   MEVOL2  :  POINTEUR SUR MEVOLV     "      "                    =
  24. C   =   KEVOL1  :  POINTEUR SUR KEVOLF                                 =
  25. C   =   KEVOL2  :  POINTEUR SUR KEVOLV                                 =
  26. C   =   MLREE1  :  POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLF          =
  27. C   =   MLREE2  :  POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLV          =
  28. C   =                                                                  =
  29. C   = CREATION :  4/12/87                                              =
  30. C   = F.ROULLIER                                                       =
  31. C=======================================================================
  32. C
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMEVOLL
  37. -INC SMLREEL
  38. C
  39.       SEGMENT TEMPP
  40.       IMPLIED DR1(NPT),DI1(NPT),DM1(NPT),DP1(NPT)
  41.       IMPLIED DR2(NPT),DI2(NPT),DM2(NPT),DP2(NPT)
  42.       ENDSEGMENT
  43.       CHARACTER *72 TI
  44.       CHARACTER*4 ITYP1,ITYP2
  45. C
  46. C     LES 2 OBJETS EVOLUTION DOIVENT ETRE DE MEME SOUS-TYPE
  47. C                                      ET DE MEME LONGUEUR
  48. C
  49.       MEVOL1=IPEV1
  50.       MEVOL2=IPEV2
  51.       SEGACT MEVOL1,MEVOL2
  52.       ITYP1=MEVOL1.ITYEVO
  53.       ITYP2=MEVOL2.ITYEVO
  54.       ICMP=1
  55.       IF (ITYP1.EQ.'COMP'.AND.ITYP2.EQ.'COMP') GO TO 198
  56.       IF (ITYP1.EQ.'REEL'.AND.ITYP2.EQ.'REEL') GO TO 199
  57.   197 MOTERR(1:8)='EVOLUTIO'
  58.       CALL ERREUR(302)
  59.       RETURN
  60.   198 ICMP=2
  61.   199 CONTINUE
  62. C
  63. C     BOUCLE SUR LES COURBES
  64. C
  65.       NC1=MEVOL1.IEVOLL(/1)
  66.       NC2=MEVOL2.IEVOLL(/1)
  67.       IF(NC1.EQ.NC2) GOTO 200
  68.       CALL ERREUR(111)
  69.       RETURN
  70. C
  71.  200  CONTINUE
  72.       N=NC1
  73.       NC=NC1/ICMP
  74.       SEGINI MEVOLL
  75.       IRET=MEVOLL
  76.       TI=TITREE
  77.       IEVTEX=TI
  78.       ITYEVO=MEVOL1.ITYEVO
  79. C
  80. C
  81.       DO 201 IC=1,NC,ICMP
  82.       KEVOL1=MEVOL1.IEVOLL(IC)
  83.       KEVOL2=MEVOL2.IEVOLL(IC)
  84.       SEGACT KEVOL1,KEVOL2
  85.       ITYP1=KEVOL1.NUMEVY
  86.       ITYP2=KEVOL2.NUMEVY
  87.       MLREE1=KEVOL1.IPROGX
  88.       MLREE2=KEVOL2.IPROGX
  89.       SEGACT MLREE1,MLREE2
  90.       L2=MLREE2.PROG(/1)
  91.       L1=MLREE1.PROG(/1)
  92. C
  93. C LES LISTREEL ONT-ILS MEME LONGUEUR ?
  94.       IF(L1.EQ.L2)GOTO 10
  95.       CALL ERREUR(337)
  96.       GOTO 100
  97.   10  CONTINUE
  98. C
  99. C  LES LISTREEL DES ABSCISSES SONT ILS IDENTIQUES ?
  100.       CALL VERIPR(MLREE1.PROG,MLREE2.PROG,L1,IRETOU,1.D-2)
  101.       IF(IRETOU.EQ.0) THEN
  102.           CALL ERREUR(394)
  103.           RETURN
  104.       ENDIF
  105. C
  106.       SEGINI KEVOLL
  107.       IEVOLL(IC)=KEVOLL
  108. c       KEVTEX=TI
  109.       KEVTEX=KEVOL1.KEVTEX
  110.       NOMEVX=KEVOL1.NOMEVX
  111.       NOMEVY=KEVOL1.NOMEVY
  112.       NUMEVX=KEVOL1.NUMEVX
  113.       NUMEVY=KEVOL1.NUMEVY
  114.       TYPX=KEVOL1.TYPX
  115.       TYPY=KEVOL1.TYPY
  116.       JG=L1
  117.       SEGINI MLREEL
  118.       IPROGX=MLREEL
  119.       DO 31 I=1,L1
  120.       PROG(I)=MLREE1.PROG(I)
  121.    31 CONTINUE
  122.       SEGDES MLREEL,KEVOLL,MLREE1,MLREE2
  123. C
  124.       MLREE1=KEVOL1.IPROGY
  125.       MLREE2=KEVOL2.IPROGY
  126.       SEGACT MLREE1,MLREE2
  127. C
  128.       NPT=L1
  129.       SEGINI TEMPP
  130.       IMOD1=0
  131.       IMOD2=0
  132.            IF (ITYP1.EQ.'MODU') THEN
  133.       IMOD1=1
  134.       DO 180 I=1,L1
  135.       DM1(I)=MLREE1.PROG(I)
  136.   180 CONTINUE
  137.            ELSE
  138.       DO 181 I=1,L1
  139.       DR1(I)=MLREE1.PROG(I)
  140.   181 CONTINUE
  141.            ENDIF
  142. C
  143.            IF (ITYP2.EQ.'MODU') THEN
  144.       IMOD2=1
  145.       DO 182 I=1,L1
  146.       DM2(I)=MLREE2.PROG(I)
  147.   182 CONTINUE
  148.            ELSE
  149.       DO 183 I=1,L1
  150.       DR2(I)=MLREE2.PROG(I)
  151.   183 CONTINUE
  152.            ENDIF
  153.       SEGDES MLREE1,MLREE2
  154.       SEGDES KEVOL1,KEVOL2
  155. C
  156.       IF (ICMP.EQ.1) GO TO 170
  157. C
  158.       KEVOL1=MEVOL1.IEVOLL(IC+1)
  159.       KEVOL2=MEVOL2.IEVOLL(IC+1)
  160.       SEGACT KEVOL1,KEVOL2
  161.       MLREE1=KEVOL1.IPROGX
  162.       SEGACT MLREE1
  163.       L1=MLREE1.PROG(/1)
  164. C
  165.       SEGINI KEVOLL
  166.       IEVOLL(IC+1)=KEVOLL
  167.       KEVTEX=TI
  168.       NOMEVX=KEVOL1.NOMEVX
  169.       NOMEVY=KEVOL1.NOMEVY
  170.       NUMEVX=KEVOL1.NUMEVX
  171.       NUMEVY=KEVOL1.NUMEVY
  172.       TYPX=KEVOL1.TYPX
  173.       TYPY=KEVOL1.TYPY
  174. C
  175.       JG=L1
  176.       SEGINI MLREEL
  177.       IPROGX=MLREEL
  178.       DO 35 I=1,L1
  179.       PROG(I)=MLREE1.PROG(I)
  180.    35 CONTINUE
  181.       SEGDES MLREEL,KEVOLL,MLREE1
  182. C
  183.       MLREE1=KEVOL1.IPROGY
  184.       MLREE2=KEVOL2.IPROGY
  185.       SEGACT MLREE1,MLREE2
  186. C
  187.            IF (IMOD1.EQ.1) THEN
  188.       DO 190 I=1,L1
  189.       DP1(I)=MLREE1.PROG(I)
  190.   190 CONTINUE
  191.            ELSE
  192.       DO 191 I=1,L1
  193.       DI1(I)=MLREE1.PROG(I)
  194.   191 CONTINUE
  195.           ENDIF
  196.           IF (IMOD2.EQ.1) THEN
  197.       DO 192 I=1,L1
  198.       DP2(I)=MLREE2.PROG(I)
  199.   192 CONTINUE
  200.           ELSE
  201.       DO 193 I=1,L1
  202.       DI2(I)=MLREE2.PROG(I)
  203.   193 CONTINUE
  204.           ENDIF
  205.       SEGDES MLREE1,MLREE2
  206.       SEGDES KEVOL1,KEVOL2
  207. C
  208.       IF (IMOD1.EQ.1) THEN
  209.       CALL CONVCP(DR1,DI1,DM1,DP1,L1,-1)
  210.       ENDIF
  211. C
  212.       IF (IMOD2.EQ.1) THEN
  213.       CALL CONVCP(DR2,DI2,DM2,DP2,L2,-1)
  214.       ENDIF
  215. C
  216.    17 IF(INV.EQ.1) THEN
  217.             DO 20 I=1,L1
  218.             DR1(I)=DR1(I)+DR2(I)
  219.             DI1(I)=DI1(I)+DI2(I)
  220.    20       CONTINUE
  221.       ELSE
  222.             DO 21 I=1,L1
  223.             DR1(I)=DR1(I)-DR2(I)
  224.             DI1(I)=DI1(I)-DI2(I)
  225.    21       CONTINUE
  226.       ENDIF
  227. C
  228.       KEVOL1=IEVOLL(IC)
  229.       KEVOL2=IEVOLL(IC+1)
  230.       SEGACT KEVOL1*MOD,KEVOL2*MOD
  231.       JG=L1
  232.       SEGINI MLREE1,MLREE2
  233.       KEVOL1.IPROGY=MLREE1
  234.       KEVOL2.IPROGY=MLREE2
  235. C
  236.       IF (IMOD1.EQ.1) THEN
  237.             CALL CONVCP(DR1,DI1,DM1,DP1,L1,1)
  238.             DO 22 I=1,L1
  239.             MLREE1.PROG(I)=DM1(I)
  240.             MLREE2.PROG(I)=DP1(I)
  241.    22       CONTINUE
  242.       ELSE
  243.             DO 23 I=1,L1
  244.             MLREE1.PROG(I)=DR1(I)
  245.             MLREE2.PROG(I)=DI1(I)
  246.    23       CONTINUE
  247.       ENDIF
  248. C
  249.       SEGDES MLREE1,MLREE2,KEVOL1,KEVOL2
  250.       GO TO 196
  251. C
  252.   170 CONTINUE
  253.       IF(INV.EQ.1) THEN
  254.             DO 171 I=1,L1
  255.             DR1(I)=DR1(I)+DR2(I)
  256.   171       CONTINUE
  257.       ELSE
  258.             DO 172 I=1,L1
  259.             DR1(I)=DR1(I)-DR2(I)
  260.   172       CONTINUE
  261.       ENDIF
  262. C
  263.       KEVOL1=IEVOLL(IC)
  264.       SEGACT KEVOL1
  265.       JG=L1
  266.       SEGINI MLREE1
  267.       KEVOL1.IPROGY=MLREE1
  268. C
  269.       IF (IMOD1.EQ.1) THEN
  270.             CALL CONVCP(DR1,DI1,DM1,DP1,L1,1)
  271.             DO 173 I=1,L1
  272.             MLREE1.PROG(I)=DM1(I)
  273.   173       CONTINUE
  274.       ELSE
  275.             DO 174 I=1,L1
  276.             MLREE1.PROG(I)=DR1(I)
  277.   174       CONTINUE
  278.       ENDIF
  279. C
  280.       SEGDES MLREE1,KEVOL1
  281. C
  282.  196  SEGSUP TEMPP
  283.  201  CONTINUE
  284. C
  285.       SEGDES MEVOLL,MEVOL1,MEVOL2
  286. C
  287.  100  CONTINUE
  288.       RETURN
  289.       END
  290.  
  291.  
  292.  
  293.  

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