Télécharger dscal.eso

Retour à la liste

Numérotation des lignes :

  1. C DSCAL SOURCE CHAT 06/03/29 21:18:55 5360
  2. SUBROUTINE DSCAL(N,DA,DX,INCX)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C SCALES A VECTOR BY A CONSTANT.
  7. C x <- ax
  8. C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE.
  9. C JACK DONGARRA, LINPACK, 3/11/78
  10. C MODIFIED 3/93 TO RETURN IF INCX .LE.0.
  11. C MODIFIED 12/3/93, ARRAY(1) DECLARATIONS CHANGED TO ARRAY(*)
  12. C
  13. C modified 5/11/98 double precision -> real*8
  14. C no unrolled loops : compiler can do that
  15. C added error handling
  16. C
  17. -INC CCOPTIO
  18. C
  19. REAL*8 DA,DX(*)
  20. INTEGER I,INCX,N,NINCX
  21. C
  22. IF( N.LE.0 .OR. INCX.LE.0 ) GOTO 9999
  23. IF(INCX.NE.1) THEN
  24. C
  25. C CODE FOR INCREMENT NOT EQUAL TO 1
  26. C
  27. NINCX = N*INCX
  28. DO 10 I = 1,NINCX,INCX
  29. DX(I) = DA*DX(I)
  30. 10 CONTINUE
  31. ELSE
  32. C
  33. C CODE FOR INCREMENT EQUAL TO 1
  34. C
  35. DO 30 I = 1,N
  36. DX(I) = DA*DX(I)
  37. 30 CONTINUE
  38. ENDIF
  39. C
  40. C Normal termination
  41. C
  42. RETURN
  43. C
  44. C Error handling
  45. C
  46. 9999 CONTINUE
  47. WRITE(IOIMP,*) 'dimension or increment lower than 1 transmitted'
  48. WRITE(IOIMP,*) 'to subroutine dscal : nothing done'
  49. call erreur(21)
  50. RETURN
  51. C
  52. C End of DSCAL
  53. C
  54. END
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  

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