Télécharger graamo.eso

Retour à la liste

Numérotation des lignes :

graamo
  1. C GRAAMO SOURCE CB215821 20/11/25 13:29:49 10792
  2. C GRAAMO SOURCE WP 23/08/94
  3. C SUBROUTINE GRAAMO ( IPLSNO, IPRIGI )
  4. ************************************************************************
  5. *
  6. * GRAAMO
  7. * -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * ORTHONORMALISER UNE SUITE DE 'CHPOINT' PAR RAPPORT A UNE RIGIDITE
  13. * si dans le processus on detecte des vecteurs du noyau on les
  14. * enleve
  15. *
  16. * MODE D'APPEL:
  17. * -------------
  18. *
  19. * CALL GRAAMO ( IPLSNO, IPRIGI )
  20. *
  21. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  22. * -----------
  23. *
  24. * IPLSNO ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  25. * LA SUITE DE 'CHPOINT' NON ORTHOGONAUX,
  26. * MAIS LINEAIREMENT INDEPENDANTS.
  27. *
  28. * IPLSNO ENTIER (S) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  29. * LA SUITE DE 'CHPOINT' ORTHOGONAUX.
  30. *
  31. * IPRIGI ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' PAR
  32. * RAPPORT AUQUEL ON ORTHOGONALISE.
  33. *
  34. *
  35. *
  36. * MODE DE FONCTIONNEMENT:
  37. * -----------------------
  38. *
  39. * PROCEDE D'ORTHOGONALISATION DE GRAM-SCHMITH.
  40. *
  41. * AUTEUR, DATE DE CREATION:
  42. * -------------------------
  43. *
  44. * A.M. JOLIVALT, W. PASILLAS 06 / 07 / 94. ( ESOPE )
  45. *
  46. ***************************************************
  47.  
  48. SUBROUTINE GRAAMO ( IPLSNO, IPRIGI )
  49.  
  50. IMPLICIT INTEGER(I-N)
  51. IMPLICIT REAL*8 (A-H,O-Z)
  52.  
  53. -INC PPARAM
  54. -INC CCOPTIO
  55. -INC SMLCHPO
  56. -INC CCREEL
  57.  
  58. ******
  59. * -- ARGUMENTS --
  60. ***
  61. POINTEUR IPLSNO.MLCHPO
  62. INTEGER IPRIGI
  63.  
  64. ******
  65. * -- VARIABLES LOCALES --
  66. ***
  67. POINTEUR IPLSO.MLCHPO
  68. INTEGER ILDIM, IB100, IB200
  69. INTEGER IPTMP, IPTMP1, IPCHPO, IPLMOT
  70. CHARACTER*(LOCOMP) MOTCLE
  71. ******
  72. * -- ON CREE UNE 'LISTCHPO' VIDE --
  73. ***
  74. N1 = 0
  75. SEGINI ,IPLSO
  76. segdes iplso
  77.  
  78. ******
  79. * -- DANS LAQUELLE ON INSERE DES VECTEURS ORTHOGONALISES
  80. * PAR GRAAM1 ET NORMES PAR NORMA1. --
  81. ***
  82. CALL MOTS1( IPLMOT, MOTCLE )
  83. IF ( IERR .NE. 0 ) RETURN
  84. SEGACT ,IPLSNO
  85. ILDIM = IPLSNO.ICHPOI(/1)
  86.  
  87. DO 100 IB100 = 1, ILDIM
  88. IPCHPO = IPLSNO.ICHPOI( IB100 )
  89. CALL GRAAM1 ( IPCHPO, IPRIGI, IPLSO, IPTMP )
  90. IF ( IERR .NE. 0 ) RETURN
  91. * on teste si la matrice est singuliere
  92. * on ne garde pas les vecteurs du noyau
  93. call xtmx(iptmp,iprigi,xm)
  94. if (abs(xm).gt.1d2*xpetit) then
  95. CALL NORMA1 ( IPTMP, IPLMOT, MOTCLE, IPTMP1 )
  96. IF ( IERR .NE. 0 ) RETURN
  97. CALL DTCHPO ( IPTMP )
  98. IF ( IERR .NE. 0 ) RETURN
  99. segact iplso*mod
  100. IPLSO.ICHPOI(**) = IPTMP1
  101. segdes iplso
  102. endif
  103. 100 CONTINUE
  104.  
  105. ******
  106. * -- ON EFFACE L'ANCIENNE LISTE --
  107. ***
  108. DO 200 IB200 = 1, ILDIM
  109. IPCHPO = IPLSNO.ICHPOI(IB200)
  110. CALL DTCHPO ( IPCHPO )
  111. IF ( IERR .NE. 0 ) RETURN
  112. 200 CONTINUE
  113. CALL DTLCHP ( IPLSNO )
  114. segsup iplsno
  115. ******
  116. * -- ON RETOURNE LA NOUVELLE LISTE --
  117. ***
  118. IPLSNO = IPLSO
  119.  
  120. RETURN
  121. END
  122.  
  123.  
  124.  
  125.  
  126.  

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