Download sespc2.eso

Back to the list

   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