Télécharger la plaquette Cast3M


fr en

Télécharger colilr.eso

Retour à la liste

Numérotation des lignes : 

colilr

  1. C COLILR    SOURCE    BP208322  15/06/26    21:15:05     8562
  2. C
  3.       SUBROUTINE COLILR(ITA1,ITAFL,N,IRETT)
  4.  
  5. C----------------------------------------------------------------------
  6. c
  7. C    COLILR : COmbinaison LIneaire de ListReels
  8. c
  9. C    CE SUBROUTINE EFFECTUE LA COMBINAISON LINEAIRE DES LISTREEL
  10. C    CONTENUS DANS ITA1, AVEC LES FLOTTANTS CONTENUS DANS TAFL
  11. C    LE RESULTAT EST UN LISTREEL, MIS DANS IRETT
  12. C    ATTENTION : TAFL EN DOUBLE PRECISION
  13. c
  14. C    Creation : bp, 2015-06-26
  15. C    Modif    : ... a completer le cas echeant ...
  16. c
  17. C----------------------------------------------------------------------
  18.       IMPLICIT INTEGER(I-N)
  19.       IMPLICIT REAL*8 (A-H,O-Z)
  20.  
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMLREEL
  25.  
  26.       SEGMENT ITA1(0)
  27.       SEGMENT/ITAFL/(TAFL(0)*D)
  28. C
  29.       IRETT=0
  30.  
  31. C----------------------------------------------------------------------
  32. c     1ere valeur
  33. c
  34.       VAL   =TAFL(1)
  35.       MLREE1=ITA1(1)
  36.       SEGACT,MLREE1
  37.       JG=MLREE1.PROG(/1)
  38.  
  39. C     creation du LISTREEL Resultat
  40.       SEGINI,MLREEL
  41.  
  42. c     1er remplissage
  43.       DO 100 IJ=1,JG
  44.         PROG(IJ)=VAL*MLREE1.PROG(IJ)
  45.  100  CONTINUE
  46.       SEGDES,MLREE1
  47.  
  48.       IF(N.EQ.1) GOTO 299
  49.  
  50.  
  51. C----------------------------------------------------------------------
  52. C     BOUCLE SUR LES LISTREELS
  53. C
  54.       DO 200 I=2,N
  55.  
  56.         VAL   =TAFL(I)
  57.         MLREE1=ITA1(I)
  58.         SEGACT,MLREE1
  59.         JG1=MLREE1.PROG(/1)
  60.         IF(JG1.NE.JG) GOTO 266
  61.  
  62. c       remplissage
  63.         DO 201 IJ=1,JG
  64.           PROG(IJ)=PROG(IJ)+VAL*MLREE1.PROG(IJ)
  65.  201    CONTINUE
  66.  
  67.         SEGDES,MLREE1
  68.  
  69.  200  CONTINUE
  70.       GOTO 299
  71.  
  72.  
  73. C----------------------------------------------------------------------
  74. *     Erreur sur la dimension des listreels
  75.  266  CONTINUE
  76.       SEGDES,MLREE1
  77.       SEGSUP,MLREEL
  78.       WRITE(IOIMP,*) '1er listreel de dimension',JG
  79.       WRITE(IOIMP,*) I,'eme listreel de dimension',JG1
  80. c     les deux LISTREEL n'ont pas la même longueur
  81.       CALL ERREUR(577)
  82.  
  83.  
  84. C----------------------------------------------------------------------
  85. *     Fin normale
  86.  299  CONTINUE
  87.       IRETT=MLREEL
  88.  
  89.  
  90.  
  91.       RETURN
  92.       END
  93.  
  94.  
  95.  

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