1 : C SESBAS SOURCE CHAT 09/10/09 21:24:18 6519 2 : C SUBROUTINE SESBAS ( IPLVEC, IPRIGI, IPMASS, IPLPMOX, IPLMOY ) 3 : ************************************************************************ 4 : * 5 : * SESBAS 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * CONSTRUIT UNE BASE ORTHONORMEE APRES CHAQUE ITERATION. CELA EST 12 : * NECESSAIRE CAR LA RIGIDITE N'ETANT PAS SYMETRIQUE, LES VECTEURS PROPRES 13 : * NE SONT PLUS ORTHOGONAUX. 14 : * 15 : * MODE D'APPEL: 16 : * ------------- 17 : * 17 : * CALL SESBAS ( IPLVEC, IPRIGI, IPMASS ) 18 : * 19 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 20 : * ----------- 21 : * 22 : * IPLVEC ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT 23 : * LE SOUS-ESPACE INITIAL. 24 : * IPLVEC ENTIER (S) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT 25 : * 26 : * IPRIGI ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' K 27 : * IPMASS ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' M 28 : * 29 : * 30 : * AUTEUR, DATE DE CREATION: 31 : * ------------------------- 32 : * 33 : * C. LE BIDEAU 09 / 2001 ( FORTRAN + ESOPE ) 34 : * 35 : *********************************************************************** 36 : 37 : SUBROUTINE SESBAS( IPLVEC, IPRIGI, IPMASS, IPLMOX, IPLMOY) 38 : 39 : IMPLICIT INTEGER(I-N) 40 : IMPLICIT REAL*8 (A-H,O-Z) 41 : 42 : -INC CCOPTIO 43 : -INC SMLCHPO 44 : -INC SMLREEL 45 : -INC SMCHPOI 46 : -INC SMRIGID 47 : -INC CCHAMP 48 : 49 : ****** 50 : * -- ARGUMENTS -- 51 : *** 52 : POINTEUR IPLVEC.MLCHPO 53 : INTEGER IPRIGI, IPMASS 54 : 55 : ****** 56 : * -- VARIABLES LOCALES -- 57 : *** 58 : POINTEUR IPLCH1.MLCHPO 59 : INTEGER ILDIM 60 : 61 : SEGACT ,IPLVEC*MOD 62 : ILDIM = IPLVEC.ICHPOI( /1 ) 63 : ****** 64 : * ON STOCKE LA LISTE EN ENTREE PUIS ON CALCULE 65 : * L'IMAGE DE LA BASE 66 : *** 67 : N1 = ILDIM 68 : SEGINI ,IPLCH1 69 : DO 95 IB95 = 1, ILDIM 70 : IPCHPO=IPLVEC.ICHPOI(IB95) 70 : CALL COPIE2(IPCHPO, IPCHP1) 71 : IPLCH1.ICHPOI(IB95) = IPCHP1 72 : 95 CONTINUE 73 : ****** 74 : * ON ORTHONORMALISE LA BASE 75 : *** 76 : IPCHPO = IPLCH1.ICHPOI(1) 76 : CALL XTY1 (IPCHPO, IPCHPO,IPLMOX,IPLMOX, XNICHP1) 77 : XICHP1 = SQRT( ABS(XNICHP1) ) 77 : CALL MUCHPO (IPCHPO, XICHP1, IRES, -1) 77 : CALL DTCHPO (IPCHPO) 78 : IPLCH1.ICHPOI(1) = IRES 79 : 80 : DO 100 IB100 = 2, ILDIM 81 : IPCHPO = IPLCH1.ICHPOI(IB100) 82 : DO 150 IB150 = 1, IB100-1 83 : IPCHP1 = IPLCH1.ICHPOI(IB150) 83 : CALL XTY1 (IPCHPO,IPCHP1,IPLMOX,IPLMOX,XNOR) 83 : CALL MUCHPO (IPCHP1, XNOR, IPRRES, 1) 84 : 85 : IF (IB150 .EQ. 1) THEN 86 : IPSOMM = IPRRES 87 : ELSE 87 : CALL ADCHPO (IPRRES, IPSOMM, IPSOM1, 1.D0, 1.D0) 87 : CALL DTCHPO (IPSOMM) 88 : IPSOMM = IPSOM1 89 : END IF 90 : 91 : 150 CONTINUE 92 : 92 : CALL ADCHPO (IPCHPO, IPSOMM, IPSOM2, 1.D0, 93 : & -1.D0) 93 : CALL XTY1 (IPSOM2, IPSOM2, IPLMOX, IPLMOX, XNIPS2) 94 : XIPS2 = SQRT( ABS(XNIPS2)) 94 : CALL MUCHPO (IPSOM2, XIPS2, IPRES2, -1) 94 : CALL DTCHPO(IPCHPO) 95 : IPLCH1.ICHPOI(IB100) = IPRES2 96 : 100 CONTINUE 97 : 98 : ****** 99 : * ON STOCKE LE RESULTAT DANS IPLVEC 100 : *** 101 : DO 1000 IB1000 = 1, ILDIM 102 : IPCHP1=IPLCH1.ICHPOI(IB1000) 102 : CALL COPIE2(IPCHP1,IPCHPO) 103 : IPLVEC.ICHPOI(IB1000) = IPCHPO 104 : 1000 CONTINUE 105 : SEGSUP IPLCH1 106 : END 107 : 108 : 109 : 110 : 111 : 112 : 113 : 114 : 115 : 116 : 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer