1 : C SESPA1 SOURCE AM 08/02/14 21:30:15 6050 2 : C SESPA1 SOURCE WP 23/08/94 3 : C SUBROUTINE SESPA1 ( IPLSO, IPRIGI, IPMASS ) 4 : ************************************************************************ 5 : * 6 : * SESPA1 7 : * ----------- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * 12 : * FAIRE UN PAS D'ITERATION DE SOUS-ESPACE: K X(i+1) = M X(i) 13 : * SUIVI D'UNE ORTHOGONALISATION: X(i+1) = GRAAMO X(i+1) 14 : * 15 : * MODE D'APPEL: 16 : * 16 : * CALL SESPA1 ( IPLSO, IPRIGI, IPLSO1 ) 17 : * 18 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 19 : * ----------- 20 : * 21 : * IPLSNO ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT 22 : * LA SUITE DE 'CHPOINT' X(i) 23 : * 24 : * IPRIGI ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' K 25 : * IPMASS ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' M 26 : * 27 : * AUTEUR, DATE DE CREATION: 28 : * ------------------------- 29 : * 30 : * A.M. JOLIVALT, W. PASILLAS 12 / 07 / 94. ( ESOPE ) 31 : * 32 : ************************************************************ 33 : 34 : SUBROUTINE SESPA1 ( IPLSO, IPRIGI, IPMASS ) 35 : 36 : IMPLICIT INTEGER(I-N) 37 : IMPLICIT REAL*8 (A-H,O-Z) 38 : 39 : -INC CCOPTIO 40 : -INC SMLCHPO 41 : -INC CCHAMP 42 : 43 : SEGMENT IPLIST(0) 44 : 45 : ****** 46 : * -- ARGUMENTS -- 47 : *** 48 : POINTEUR IPLSO.MLCHPO 49 : INTEGER IPRIGI, IPMASS 50 : 51 : ****** 52 : * -- VARIABLES LOCALES -- 53 : *** 54 : * SEGMENT IPLIST(0) 55 : INTEGER IPCHPO, IPCHP1, IPCHP2 56 : INTEGER IB100, IB200, IB300, ILDIM 57 : CHARACTER*4 MOTCLE 58 : 59 : SEGINI ,IPLIST 60 : SEGDES ,IPLIST 61 : 62 : 63 : ****** 64 : * -- ON VA FAIRE POINTER LES ELEMENTS DE IPLIST VERS LES 'CHPOINTS' 65 : * CONTENUS DANS IPLSO. LES MODIFICATIONS EFFECTUEES SUR LES 'CHPO' 66 : * DE IPLIST SERONT DONC EFFECTUEES AUSSI SUR CEUX DE IPLSO. -- 67 : *** 68 : SEGACT ,IPLSO 69 : ILDIM = IPLSO.ICHPOI(/1) 70 : SEGDES ,IPLSO 71 : 72 : SEGACT IPLIST*MOD 73 : SEGACT IPLSO 74 : DO 100 IB100 = 1, ILDIM 75 : IPLIST(**) = IPLSO.ICHPOI( IB100 ) 76 : 100 CONTINUE 77 : SEGDES ,IPLIST, IPLSO 78 : 79 : ****** 80 : * -- ON MULTIPLIE LES 'CHPOINT' DE IPLIST PAR IPMASS. 81 : * ET ON ANNULLE LES TERMES EN PI ( POUR LES ELEMENTS LIQUIDES ) -- 82 : *** 83 : SEGACT IPLIST*MOD 84 : DO 200 IB200 = 1, ILDIM 85 : IPCHPO = IPLIST( IB200 ) 85 : CALL MUCPRI ( IPCHPO, IPMASS, IPCHP1 ) 86 : IF ( IERR .NE. 0 ) RETURN 86 : CALL DTCHPO( IPCHPO ) 87 : IF ( IERR .NE. 0 ) RETURN 87 : CALL ANCHPO( IPCHP1, NOMDU(15), IPCHP2 ) 88 : IF ( IERR .NE. 0 ) RETURN 88 : CALL DTCHPO( IPCHP1 ) 89 : IF ( IERR .NE. 0 ) RETURN 90 : IPLIST( IB200 ) = IPCHP2 91 : 200 CONTINUE 92 : SEGDES ,IPLIST 93 : 94 : 95 : ****** 96 : * -- ON RESOUD LE SYSTEME K X(i+1) = M X(i) -- 97 : *** 97 : CALL RESOU1 ( IPRIGI, IPLIST, 0, 1 ,1D-15) 98 : IF ( IERR .NE. 0 ) THEN 99 : 100 : WRITE ( IOIMP, 1000 ) 101 : 102 : 1000 FORMAT(/,' La matrice d''iteration (K-W2M) est singulière 102 : 1 (a la precision',/,' machine près). Essayez de decaller la fréque 103 : 3nce fournie a VIBR',/) 104 : 105 : 106 : RETURN 107 : ENDIF 108 : 109 : ****** 110 : * -- ON REMET DANS LSO, EN NORMANT AVEC LA NORME DU MAX. -- 111 : *** 111 : CALL MOTS1( IPLMOT, MOTCLE ) 112 : IF ( IERR .NE. 0 ) RETURN 113 : SEGACT ,IPLIST 114 : SEGACT IPLSO*MOD 115 : DO 300 IB300 = 1, ILDIM 116 : IPCHPO = IPLIST( IB300 ) 116 : CALL NORMA1 ( IPCHPO, IPLMOT, MOTCLE, IPCHP1 ) 117 : IF ( IERR .NE. 0 ) RETURN 117 : CALL DTCHPO ( IPCHPO ) 118 : IF ( IERR .NE. 0 ) RETURN 119 : IPLSO.ICHPOI( IB300 ) = IPCHP1 120 : 300 CONTINUE 121 : SEGDES ,IPLIST, IPLSO 122 : 123 : SEGSUP ,IPLIST 124 : 125 : RETURN 126 : END 127 : 128 : 129 : 130 : 131 :
© Cast3M 2003 - All rights reserved.
Disclaimer