Télécharger la plaquette Cast3M


fr en

Télécharger graam1.eso

Retour à la liste

Numérotation des lignes : 

graam1

  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