Télécharger colilr.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  22. -INC SMLREEL
  23.  
  24. SEGMENT ITA1(0)
  25. SEGMENT/ITAFL/(TAFL(0)*D)
  26. C
  27. IRETT=0
  28.  
  29. C----------------------------------------------------------------------
  30. c 1ere valeur
  31. c
  32. VAL =TAFL(1)
  33. MLREE1=ITA1(1)
  34. SEGACT,MLREE1
  35. JG=MLREE1.PROG(/1)
  36.  
  37. C creation du LISTREEL Resultat
  38. SEGINI,MLREEL
  39.  
  40. c 1er remplissage
  41. DO 100 IJ=1,JG
  42. PROG(IJ)=VAL*MLREE1.PROG(IJ)
  43. 100 CONTINUE
  44. SEGDES,MLREE1
  45.  
  46. IF(N.EQ.1) GOTO 299
  47.  
  48.  
  49. C----------------------------------------------------------------------
  50. C BOUCLE SUR LES LISTREELS
  51. C
  52. DO 200 I=2,N
  53.  
  54. VAL =TAFL(I)
  55. MLREE1=ITA1(I)
  56. SEGACT,MLREE1
  57. JG1=MLREE1.PROG(/1)
  58. IF(JG1.NE.JG) GOTO 266
  59.  
  60. c remplissage
  61. DO 201 IJ=1,JG
  62. PROG(IJ)=PROG(IJ)+VAL*MLREE1.PROG(IJ)
  63. 201 CONTINUE
  64.  
  65. SEGDES,MLREE1
  66.  
  67. 200 CONTINUE
  68. GOTO 299
  69.  
  70.  
  71. C----------------------------------------------------------------------
  72. * Erreur sur la dimension des listreels
  73. 266 CONTINUE
  74. SEGDES,MLREE1
  75. SEGSUP,MLREEL
  76. WRITE(IOIMP,*) '1er listreel de dimension',JG
  77. WRITE(IOIMP,*) I,'eme listreel de dimension',JG1
  78. c les deux LISTREEL n'ont pas la même longueur
  79. CALL ERREUR(577)
  80.  
  81.  
  82. C----------------------------------------------------------------------
  83. * Fin normale
  84. 299 CONTINUE
  85. IRETT=MLREEL
  86.  
  87.  
  88.  
  89. RETURN
  90. END
  91.  
  92.  
  93.  

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