Télécharger la plaquette Cast3M


fr en

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