Sources Esope | Cast3M

orthog
C ORTHOG    SOURCE    CHAT      05/01/13    02:06:39     5004
      SUBROUTINE ORTHOG
************************************************************************
*
*                             O R T H O G
*                             -----------
*
*         SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "ORTHOGONALISER"
*
* FONCTION:
* ---------
*
*     ORTHOGONALISER UN OBJET "XX" PAR RAPPORT A UNE SUITE D'OBJETS
*     "U(I)" ORTHOGONAUX ENTRE EUX ET DE MEME TYPE QUE "XX".
*
*     L'ORTHOGONALITE CHOISIE EST DEFINIE AU MOYEN D'UN OBJET "RR" TEL
*     QUE L'EXPRESSION:
*        XX * RR * U(I)
*     AIT UN SENS ET PUISSE ETRE COMPAREE A "0".
*
* PHRASE D'APPEL (EN GIBIANE):
* ----------------------------
*
*     YY = ORTHOGONALISER (SEMBLABLE) XX SUIT-U SUI-UTRU (SUIT-RU) RR
*          (EE (NN) ) ;
*
*     LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS.
*
* OPERANDES ET RESULTATS:
* -----------------------
*
*     SEMBLABL  'MOT'       MOT-CLE VALABLE SI "XX" EST DE TYPE
*                           'CHPOINT'. IL SIGNIFIE QUE L'ON EST CERTAIN
*                           QUE TOUS LES CHPOINTS S'APPUIENT SUR LES
*                           MEMES POINTS, AVEC LES MEMES COMPOSANTES.
*                           C'EST UNE OPTION QUI ACCELERE LE CALCUL,
*                           MAIS QUI DEMANDE AU PROGRAMMEUR UNE BONNE
*                           MAITRISE DES OPERANDES FOURNIS.
*     XX        TYPE-1      OBJET A ORTHOGONALISER.
*     SUIT-U    TYPE-2      SUITE D'OBJETS "U(I)" AUXQUELS "XX" DOIT ETR
*                           ORTHOGONAL.
*     SUI-UTRU  'LISTREEL'  SUITE DES PRODUITS "U(I)*RR*U(I)".
*     SUIT-RU   TYPE-3      SUITE D'OBJETS EGAUX A RR*U(I). SI ELLE EST
*                           FOURNIE, CETTE SUITE EVITE DE REFAIRE LES
*                           PRODUITS RR*U(I).
*     RR        TYPE-4      OBJET DEFINISSANT L'ORTHOGONALITE.
*     EE        'FLOTTANT'  PRECISION D'ORTHOGONALITE DEMANDEE.
*     NN        'ENTIER  '  NOMBRE DE FOIS MAXI QUE L'ON DOIT REFAIRE
*                           L'OPERATION D'ORTHOGONALISATION, POUR
*                           COMPENSER LES ERREURS D'ARRONDI (N'A DE SENS
*                           QUE SI L'ON A DONNE UNE PRECISION "EE").
*     YY        TYPE-1      OBJET ORTHOGONALISE.
*
*     TYPE-1   --->   TYPE-2      TYPE-3      TYPE-4
*
*     CHPOINT         LISTCHPO    LISTCHPO    RIGIDITE
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     IPOIN1  ENTIER    POINTEUR SUR "XX".
*     IPOIN2  ENTIER    POINTEUR SUR "SUIT-U".
*     IPOIN3  ENTIER    POINTEUR SUR "SUI-UTRU".
*     IPOIN4  ENTIER    POINTEUR SUR "SUIT-RU".
*     IPOIN5  ENTIER    POINTEUR SUR "RR".
*     IPOIN6  ENTIER    POINTEUR SUR "YY".
*     LLIST   ENTIER    NOMBRE D'ELEMENTS DE LA SUITE "SUIT-U".
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     10 AVRIL 1985
*
* LANGAGE:
* --------
*
*     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
*
      REAL*8 EE,XMINIM
*
      PARAMETER (NBRMOT = 1)
      PARAMETER (NBRTYP = 1)
      PARAMETER (NFOIS = 1)
*
      CHARACTER*4 LISMOT(NBRMOT)
      CHARACTER*(8) MOTYPE
*
      DATA LISMOT/'SEMB'/
*
*     -- LECTURE D'UNE OPTION EVENTUELLE --
*
      ICODE = 0
      NBMOT = NBRMOT
      CALL LIRMOT (LISMOT,NBMOT,NUMMOT,ICODE)
      IF (IERR .NE. 0) RETURN
*
*     -- LECTURE DE "XX" --
*
      CALL LIROBJ ('CHPOINT',IPOIN1,1,IRETOU)
      IF (IERR .NE. 0) RETURN
*
*     -- LECTURE DES "U(I)" ET DE LEUR QUANTITE --
*
      CALL LIROBJ ('LISTCHPO',IPOIN2,1,IRETOU)
      IF (IERR .NE. 0) RETURN
*
      CALL DIMEN2 (IPOIN2,LLIST)
      IF (IERR .NE. 0) RETURN
*
*     -- LECTURE DES "UT.RR.U" --
*
      CALL LIROBJ ('LISTREEL',IPOIN3,1,IRETOU)
      IF (IERR .NE. 0) RETURN
*
      CALL DIMEN2 (IPOIN3,LLIS3)
      IF (IERR .NE. 0) RETURN
      IF (LLIS3 .NE. LLIST) THEN
         CALL ERREUR (217)
         RETURN
      END IF
*
*     -- LECTURE DES "RR*U(I)" ET DE "RR" --
*
      CALL LIROBJ ('LISTCHPO',IPOIN4,0,IRETOU)
      IF (IRETOU .EQ. 1) THEN
         CALL DIMEN2 (IPOIN4,LLIS4)
         IF (IERR .NE. 0) RETURN
         IF (LLIS4 .NE. LLIST) THEN
            CALL ERREUR (217)
            RETURN
         END IF
      ELSE
         IPOIN4 = 0
      END IF
*
      CALL LIROBJ ('RIGIDITE',IPOIN5,1,IRETOU)
      IF (IERR .NE. 0) RETURN
*
*     -- LECTURE DE "EE" ET DE "NN" --
*
      ICODE = 0
      XMINIM = 0.D0
      CALL LIRE04 (XMINIM,EE,0,ICODE,IRETOU)
      IF (IRETOU .EQ. 0) THEN
         EE = 0.D0
         NN = NFOIS
      ELSE
         ICODE = 0
         MINIME = 1
         CALL LIRE03 (MINIME,NN,ICODE,IRETOU)
         IF (IRETOU .EQ. 0) THEN
            NN = NFOIS
         END IF
      END IF
*
*     -- ORTHOGONALISATION --
*
         CALL ORTH10 (NUMMOT,IPOIN1,IPOIN2,IPOIN3,IPOIN4,LLIST,IPOIN5
     &              ,EE,NN,  IPOIN6)
*
      CALL ECROBJ ('CHPOINT',IPOIN6)
*
      END