1 : C SESPC2 SOURCE FANDEUR 12/11/15 21:15:04 7571 2 : C SESPA2 SOURCE CHAT 05/01/13 03:14:36 5004 3 : C SESPA2 SOURCE WP 20/08/94 4 : C SUBROUTINE SESPA2 ( IPLVEC, IPRIGI, IPRIG1 ) 5 : ************************************************************************ 6 : * 7 : * SESPC2 inspiré de sespa2 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * CALCULER LA RESTRICTION DE IPRIGI AU LE SOUS-ESPACE IPLVEC. 14 : * 15 : * 16 : * MODE D'APPEL: 17 : * 17 : * CALL SESPA2 ( IPLVEC, IPRIGI, IPRIG1 ) 18 : * 19 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 20 : * ----------- 21 : * 22 : * IPLVEC ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT 23 : * LA SUITE DE 'CHPOINT' X(i) 24 : * 25 : * IPRIGI ENTIER (E) POINTEUR SUR L'OBJET 'RIGIDITE' K 26 : * IPRIG1 ENTIER (E) POINTEUR SUR L'OBJET 'MATRIX' K=Xt K X 27 : * 28 : * 29 : * A.M. JOLIVALT, W. PASILLAS 12 / 07 / 94. ( ESOPE ) 30 : * 31 : ************************************************************ 32 : 33 : SUBROUTINE SESPC2 ( IPLVEC, IPRIGI, IPRIG1 ) 34 : 35 : IMPLICIT INTEGER(I-N) 36 : IMPLICIT REAL*8 (A-H,O-Z) 37 : 38 : -INC CCOPTIO 39 : -INC SMLCHPO 40 : -INC SMLMOTS 41 : -INC SMCHPOI 42 : 43 : * SEGMENT ,MATRIX 44 : * REAL*8 A(N,N) 45 : * ENDSEGMENT 46 : -INC SMRIGID 47 : 48 : ****** 49 : * -- ARGUMENTS -- 50 : *** 51 : POINTEUR IPLVEC.MLCHPO 52 : * POINTEUR IPRIG1.MATRIX 53 : POINTEUR IPRIG1.XMATRI 54 : INTEGER IPRIGI 55 : 56 : ****** 57 : * -- VARIABLES LOCALES -- 58 : *** 59 : INTEGER ILDIM, IB100, IPCHP1, IPCHP2 60 : REAL*8 XITMXJ 61 : 62 : 63 : ****** 64 : * -- K' = Xt K X -- 65 : *** 66 : SEGACT ,IPLVEC 67 : ILDIM = IPLVEC.ICHPOI(/1) 68 : * N = ILDIM 69 : nelrig=1 70 : NLIGRD = ILDIM 71 : NLIGRP = ILDIM 72 : SEGINI ,IPRIG1 73 : 74 : DO 100 IB100 = 1, ILDIM 75 : IPCHP1 = IPLVEC.ICHPOI( IB100 ) 75 : CALL MUCPRI(IPCHP1,IPRIGI,IPCHP3) 76 : DO 200 IB200 = 1, ILDIM 77 : IPCHP2 = IPLVEC.ICHPOI( IB200 ) 78 : IF(IB200.EQ.1.AND.IB100.EQ.1) 78 : > CALL CORRSP(iprigi,IPCHP2,IPCHP3,MLMOT1,MLMOT2) 78 : CALL XTY1 (IPCHP2,IPCHP3,MLMOT1,MLMOT2, XITMXJ) 79 : IF ( IERR .NE. 0 ) RETURN 80 : * IPRIG1.A(IB100,IB200) = XITMXJ 81 : IPRIG1.RE(IB200,IB100) = XITMXJ 82 : 200 CONTINUE 82 : CALL DTCHPO(IPCHP3) 83 : 100 CONTINUE 84 : SEGSUP MLMOT1,MLMOT2 85 : SEGDES ,IPLVEC 86 : c* SEGDES,IPRIG1 87 : 88 : RETURN 89 : END 90 : 91 : 92 : 93 : 94 : 95 :
© Cast3M 2003 - All rights reserved.
Disclaimer