Télécharger orthog.eso

Retour à la liste

Numérotation des lignes :

  1. C ORTHOG SOURCE CHAT 05/01/13 02:06:39 5004
  2. SUBROUTINE ORTHOG
  3. ************************************************************************
  4. *
  5. * O R T H O G
  6. * -----------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "ORTHOGONALISER"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * ORTHOGONALISER UN OBJET "XX" PAR RAPPORT A UNE SUITE D'OBJETS
  14. * "U(I)" ORTHOGONAUX ENTRE EUX ET DE MEME TYPE QUE "XX".
  15. *
  16. * L'ORTHOGONALITE CHOISIE EST DEFINIE AU MOYEN D'UN OBJET "RR" TEL
  17. * QUE L'EXPRESSION:
  18. * XX * RR * U(I)
  19. * AIT UN SENS ET PUISSE ETRE COMPAREE A "0".
  20. *
  21. * PHRASE D'APPEL (EN GIBIANE):
  22. * ----------------------------
  23. *
  24. * YY = ORTHOGONALISER (SEMBLABLE) XX SUIT-U SUI-UTRU (SUIT-RU) RR
  25. * (EE (NN) ) ;
  26. *
  27. * LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS.
  28. *
  29. * OPERANDES ET RESULTATS:
  30. * -----------------------
  31. *
  32. * SEMBLABL 'MOT' MOT-CLE VALABLE SI "XX" EST DE TYPE
  33. * 'CHPOINT'. IL SIGNIFIE QUE L'ON EST CERTAIN
  34. * QUE TOUS LES CHPOINTS S'APPUIENT SUR LES
  35. * MEMES POINTS, AVEC LES MEMES COMPOSANTES.
  36. * C'EST UNE OPTION QUI ACCELERE LE CALCUL,
  37. * MAIS QUI DEMANDE AU PROGRAMMEUR UNE BONNE
  38. * MAITRISE DES OPERANDES FOURNIS.
  39. * XX TYPE-1 OBJET A ORTHOGONALISER.
  40. * SUIT-U TYPE-2 SUITE D'OBJETS "U(I)" AUXQUELS "XX" DOIT ETR
  41. * ORTHOGONAL.
  42. * SUI-UTRU 'LISTREEL' SUITE DES PRODUITS "U(I)*RR*U(I)".
  43. * SUIT-RU TYPE-3 SUITE D'OBJETS EGAUX A RR*U(I). SI ELLE EST
  44. * FOURNIE, CETTE SUITE EVITE DE REFAIRE LES
  45. * PRODUITS RR*U(I).
  46. * RR TYPE-4 OBJET DEFINISSANT L'ORTHOGONALITE.
  47. * EE 'FLOTTANT' PRECISION D'ORTHOGONALITE DEMANDEE.
  48. * NN 'ENTIER ' NOMBRE DE FOIS MAXI QUE L'ON DOIT REFAIRE
  49. * L'OPERATION D'ORTHOGONALISATION, POUR
  50. * COMPENSER LES ERREURS D'ARRONDI (N'A DE SENS
  51. * QUE SI L'ON A DONNE UNE PRECISION "EE").
  52. * YY TYPE-1 OBJET ORTHOGONALISE.
  53. *
  54. * TYPE-1 ---> TYPE-2 TYPE-3 TYPE-4
  55. *
  56. * CHPOINT LISTCHPO LISTCHPO RIGIDITE
  57. *
  58. * LEXIQUE: (ORDRE ALPHABETIQUE)
  59. * --------
  60. *
  61. * IPOIN1 ENTIER POINTEUR SUR "XX".
  62. * IPOIN2 ENTIER POINTEUR SUR "SUIT-U".
  63. * IPOIN3 ENTIER POINTEUR SUR "SUI-UTRU".
  64. * IPOIN4 ENTIER POINTEUR SUR "SUIT-RU".
  65. * IPOIN5 ENTIER POINTEUR SUR "RR".
  66. * IPOIN6 ENTIER POINTEUR SUR "YY".
  67. * LLIST ENTIER NOMBRE D'ELEMENTS DE LA SUITE "SUIT-U".
  68. *
  69. * AUTEUR, DATE DE CREATION:
  70. * -------------------------
  71. *
  72. * PASCAL MANIGOT 10 AVRIL 1985
  73. *
  74. * LANGAGE:
  75. * --------
  76. *
  77. * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  78. *
  79. ************************************************************************
  80. *
  81. IMPLICIT INTEGER(I-N)
  82. -INC CCOPTIO
  83. *
  84. REAL*8 EE,XMINIM
  85. *
  86. PARAMETER (NBRMOT = 1)
  87. PARAMETER (NBRTYP = 1)
  88. PARAMETER (NFOIS = 1)
  89. *
  90. CHARACTER*4 LISMOT(NBRMOT)
  91. CHARACTER*(8) MOTYPE
  92. *
  93. DATA LISMOT/'SEMB'/
  94. *
  95. * -- LECTURE D'UNE OPTION EVENTUELLE --
  96. *
  97. ICODE = 0
  98. NBMOT = NBRMOT
  99. CALL LIRMOT (LISMOT,NBMOT,NUMMOT,ICODE)
  100. IF (IERR .NE. 0) RETURN
  101. *
  102. * -- LECTURE DE "XX" --
  103. *
  104. CALL LIROBJ ('CHPOINT',IPOIN1,1,IRETOU)
  105. IF (IERR .NE. 0) RETURN
  106. *
  107. * -- LECTURE DES "U(I)" ET DE LEUR QUANTITE --
  108. *
  109. CALL LIROBJ ('LISTCHPO',IPOIN2,1,IRETOU)
  110. IF (IERR .NE. 0) RETURN
  111. *
  112. CALL DIMEN2 (IPOIN2,LLIST)
  113. IF (IERR .NE. 0) RETURN
  114. *
  115. * -- LECTURE DES "UT.RR.U" --
  116. *
  117. CALL LIROBJ ('LISTREEL',IPOIN3,1,IRETOU)
  118. IF (IERR .NE. 0) RETURN
  119. *
  120. CALL DIMEN2 (IPOIN3,LLIS3)
  121. IF (IERR .NE. 0) RETURN
  122. IF (LLIS3 .NE. LLIST) THEN
  123. CALL ERREUR (217)
  124. RETURN
  125. END IF
  126. *
  127. * -- LECTURE DES "RR*U(I)" ET DE "RR" --
  128. *
  129. CALL LIROBJ ('LISTCHPO',IPOIN4,0,IRETOU)
  130. IF (IRETOU .EQ. 1) THEN
  131. CALL DIMEN2 (IPOIN4,LLIS4)
  132. IF (IERR .NE. 0) RETURN
  133. IF (LLIS4 .NE. LLIST) THEN
  134. CALL ERREUR (217)
  135. RETURN
  136. END IF
  137. ELSE
  138. IPOIN4 = 0
  139. END IF
  140. *
  141. CALL LIROBJ ('RIGIDITE',IPOIN5,1,IRETOU)
  142. IF (IERR .NE. 0) RETURN
  143. *
  144. * -- LECTURE DE "EE" ET DE "NN" --
  145. *
  146. ICODE = 0
  147. XMINIM = 0.D0
  148. CALL LIRE04 (XMINIM,EE,0,ICODE,IRETOU)
  149. IF (IRETOU .EQ. 0) THEN
  150. EE = 0.D0
  151. NN = NFOIS
  152. ELSE
  153. ICODE = 0
  154. MINIME = 1
  155. CALL LIRE03 (MINIME,NN,ICODE,IRETOU)
  156. IF (IRETOU .EQ. 0) THEN
  157. NN = NFOIS
  158. END IF
  159. END IF
  160. *
  161. * -- ORTHOGONALISATION --
  162. *
  163. CALL ORTH10 (NUMMOT,IPOIN1,IPOIN2,IPOIN3,IPOIN4,LLIST,IPOIN5
  164. & ,EE,NN, IPOIN6)
  165. *
  166. CALL ECROBJ ('CHPOINT',IPOIN6)
  167. *
  168. END
  169.  
  170.  

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