Télécharger graam1.eso

Retour à la liste

Numérotation des lignes :

  1. C GRAAM1 SOURCE CHAT 05/01/13 00:19:22 5004
  2. C GRAAM1 SOURCE WP 23/08/94
  3. C SUBROUTINE GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
  4. ************************************************************************
  5. *
  6. * GRAMM1
  7. * --------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * ORTHONORMALISER UN 'CHPOINT' PAR RAPPORT A UNE SUITE DE 'CHPOINT'.
  13. * MEME CHOSE QUE ORTH1, MAIS PLUS SIMPLE. CE PROGRAMME SERA MODIFIE
  14. * DE FACON A REDUIRE LE NOMBRE D'OPERATIONS.
  15. *
  16. * MODE D'APPEL:
  17. * -------------
  18. *
  19. * CALL GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
  20. *
  21. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  22. * -----------
  23. *
  24. * IPCHNO ENTIER (E) POINTEUR SUR L'OBJET 'CHPOINT' DEVANT
  25. * ETRE ORTHOGONALISE.
  26. *
  27. * IPRIGI ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' PAR
  28. * RAPPORT AUQUEL ON ORTHOGONALISE.
  29. *
  30. * IPLSO ENTIER (E) POINTEUR SUR L'OBJET 'LISTCHPO' CONTENANT
  31. * LA SUITE DE 'CHPOINT' OTHOGONAUX PAR
  32. * RAPPORT AUXQUELS 'CHNO' EST ORTHOGONALISE.
  33. *
  34. * IPCHO ENTIER (S) POINTEUR SUR L'OBJET 'CHPOINT' CONTENANT
  35. * LE 'CHPOINT' SOLUTION.
  36. *
  37. *
  38. * MODE DE FONCTIONNEMENT:
  39. * -----------------------
  40. *
  41. * PROCEDE D'ORTHOGONALISATION DE GRAAM-SCHMITT.
  42. *
  43. *
  44. * AUTEUR, DATE DE CREATION:
  45. * -------------------------
  46. *
  47. * A.M. JOLIVALT, W. PASILLAS 06 / 07 / 94.
  48. *
  49. ************************************************************************
  50.  
  51. SUBROUTINE GRAAM1 ( IPCHNO, IPRIGI, IPLSO, IPCHO )
  52.  
  53. IMPLICIT INTEGER(I-N)
  54. IMPLICIT REAL*8 (A-H,O-Z)
  55.  
  56. -INC CCOPTIO
  57.  
  58. ******
  59. * -- ARGUMENTS --
  60. ***
  61. INTEGER IPCHNO, IPRIGI, IPLSO, IPCHO
  62.  
  63. ******
  64. * -- VARIABLES LOCALES --
  65. ***
  66. INTEGER IPUI, IPCHO1, IB100, ILDIM
  67. REAL*8 ALPHA, UTMUI, UITMUI
  68.  
  69. CALL DIMEN2 ( IPLSO, ILDIM )
  70. IF ( IERR .NE. 0 ) RETURN
  71. CALL COPIE2 ( IPCHNO, IPCHO )
  72. IF ( IERR .NE. 0 ) RETURN
  73. IF ( ILDIM .GT. 0 ) THEN
  74. DO 100 IB100 = 1, ILDIM
  75. CALL EXTRA4 ( IPLSO, IB100, IPUI )
  76. IF ( IERR .NE. 0 ) RETURN
  77. CALL YTMX ( IPCHNO, IPUI, IPRIGI, UTMUI )
  78. IF ( IERR .NE. 0 ) RETURN
  79. CALL XTMX ( IPUI, IPRIGI, UITMUI )
  80. IF ( IERR .NE. 0 ) RETURN
  81. ALPHA = ( -1.D0 * UTMUI ) / UITMUI
  82. CALL COMBI2( IPCHO, 1.D0, IPUI, ALPHA, IPCHO1 )
  83. IF ( IERR .NE. 0 ) RETURN
  84. CALL DTCHPO( IPCHO )
  85. IF ( IERR .NE. 0 ) RETURN
  86. IPCHO = IPCHO1
  87. 100 CONTINUE
  88. ENDIF
  89.  
  90. RETURN
  91. END
  92.  
  93.  

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