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 PPARAM
  57. -INC CCOPTIO
  58.  
  59. ******
  60. * -- ARGUMENTS --
  61. ***
  62. INTEGER IPCHNO, IPRIGI, IPLSO, IPCHO
  63.  
  64. ******
  65. * -- VARIABLES LOCALES --
  66. ***
  67. INTEGER IPUI, IPCHO1, IB100, ILDIM
  68. REAL*8 ALPHA, UTMUI, UITMUI
  69.  
  70. CALL DIMEN2 ( IPLSO, ILDIM )
  71. IF ( IERR .NE. 0 ) RETURN
  72. CALL COPIE2 ( IPCHNO, IPCHO )
  73. IF ( IERR .NE. 0 ) RETURN
  74. IF ( ILDIM .GT. 0 ) THEN
  75. DO 100 IB100 = 1, ILDIM
  76. CALL EXTRA4 ( IPLSO, IB100, IPUI )
  77. IF ( IERR .NE. 0 ) RETURN
  78. CALL YTMX ( IPCHNO, IPUI, IPRIGI, UTMUI )
  79. IF ( IERR .NE. 0 ) RETURN
  80. CALL XTMX ( IPUI, IPRIGI, UITMUI )
  81. IF ( IERR .NE. 0 ) RETURN
  82. ALPHA = ( -1.D0 * UTMUI ) / UITMUI
  83. CALL COMBI2( IPCHO, 1.D0, IPUI, ALPHA, IPCHO1 )
  84. IF ( IERR .NE. 0 ) RETURN
  85. CALL DTCHPO( IPCHO )
  86. IF ( IERR .NE. 0 ) RETURN
  87. IPCHO = IPCHO1
  88. 100 CONTINUE
  89. ENDIF
  90.  
  91. RETURN
  92. END
  93.  
  94.  

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