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 98 : CALL LIRMOT (LISMOT,NBMOT,NUMMOT,ICODE) 99 : IF (IERR .NE. 0) RETURN 100 : * 101 : * -- LECTURE DE "XX" -- 102 : * 102 : CALL LIROBJ ('CHPOINT',IPOIN1,1,IRETOU) 103 : IF (IERR .NE. 0) RETURN 104 : * 105 : * -- LECTURE DES "U(I)" ET DE LEUR QUANTITE -- 106 : * 106 : CALL LIROBJ ('LISTCHPO',IPOIN2,1,IRETOU) 107 : IF (IERR .NE. 0) RETURN 108 : * 108 : CALL DIMEN2 (IPOIN2,LLIST) 109 : IF (IERR .NE. 0) RETURN 110 : * 111 : * -- LECTURE DES "UT.RR.U" -- 112 : * 112 : CALL LIROBJ ('LISTREEL',IPOIN3,1,IRETOU) 113 : IF (IERR .NE. 0) RETURN 114 : * 114 : CALL DIMEN2 (IPOIN3,LLIS3) 115 : IF (IERR .NE. 0) RETURN 116 : IF (LLIS3 .NE. LLIST) THEN 116 : CALL ERREUR (217) 117 : RETURN 118 : END IF 119 : * 120 : * -- LECTURE DES "RR*U(I)" ET DE "RR" -- 121 : * 121 : CALL LIROBJ ('LISTCHPO',IPOIN4,0,IRETOU) 122 : IF (IRETOU .EQ. 1) THEN 122 : CALL DIMEN2 (IPOIN4,LLIS4) 123 : IF (IERR .NE. 0) RETURN 124 : IF (LLIS4 .NE. LLIST) THEN 124 : CALL ERREUR (217) 125 : RETURN 126 : END IF 127 : ELSE 128 : IPOIN4 = 0 129 : END IF 130 : * 130 : CALL LIROBJ ('RIGIDITE',IPOIN5,1,IRETOU) 131 : IF (IERR .NE. 0) RETURN 132 : * 133 : * -- LECTURE DE "EE" ET DE "NN" -- 134 : * 135 : ICODE = 0 136 : XMINIM = 0.D0 136 : CALL LIRE04 (XMINIM,EE,0,ICODE,IRETOU) 137 : IF (IRETOU .EQ. 0) THEN 138 : EE = 0.D0 139 : NN = NFOIS 140 : ELSE 141 : ICODE = 0 142 : MINIME = 1 142 : CALL LIRE03 (MINIME,NN,ICODE,IRETOU) 143 : IF (IRETOU .EQ. 0) THEN 144 : NN = NFOIS 145 : END IF 146 : END IF 147 : * 148 : * -- ORTHOGONALISATION -- 149 : * 149 : CALL ORTH10 (NUMMOT,IPOIN1,IPOIN2,IPOIN3,IPOIN4,LLIST,IPOIN5 150 : & ,EE,NN, IPOIN6) 151 : * 151 : CALL ECROBJ ('CHPOINT',IPOIN6) 152 : * 153 : END 154 :
© Cast3M 2003 - All rights reserved.
Disclaimer