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