Esope source files

   1 : C SESRED    SOURCE    CHAT      05/01/13    03:14:57     5004           
   2 : C     SUBROUTINE SESRED ( IPLVEC, IPRIGI, IPMASS, MATRED, IPLMOX )
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                                SESRED                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     CONSTRUIT LA MATRICE REDUITE MATRED DE L'OPERATEUR (K**-1)M SUR LA BASE IPLVEC
  12 : *
  13 : * MODE D'APPEL:                                 
  14 : * -------------
  15 : *                                                                               
  15 : *     CALL SESRED ( IPLVEC, IPRIGI, IPMASS, MATRED )
  16 : *                                                                               
  17 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  18 : * -----------                                                                   
  19 : *
  20 : *     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  21 : *                            LA BASE DE REDUCTION ET D'ITERATIONS
  22 : *     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' K
  23 : *     IPMASS  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' M
  24 : *     MATRED  ENTIER    (S)  POINTEUR SUR LA MATRICE REDUITE SUR IPLVEC.
  25 : *                            ELLE VA SERVIR AUX ITERATIONS
  26 : * 
  27 : *
  28 : * AUTEUR, DATE DE CREATION:                                                     
  29 : * -------------------------                                                     
  30 : *                                                                               
  31 : *   C. LE BIDEAU  09 / 2001  ( FORTRAN + ESOPE )                                       
  32 : *
  33 : ***********************************************************************
  34 : 
  35 :       SUBROUTINE SESRED (IPLVEC,IPRIGI,IPMASS,MATRED,IPLMOX )
  36 :                       
  37 :       IMPLICIT INTEGER(I-N)
  38 :       IMPLICIT REAL*8 (A-H,O-Z)
  39 : 
  40 : -INC  CCOPTIO

  41 : -INC  SMLCHPO

  42 : -INC  SMLREEL

  43 :                                                  
  44 : 
  45 : ******
  46 : *     -- ARGUMENTS --
  47 : ***
  48 :       POINTEUR IPLVEC.MLCHPO
  49 :       INTEGER  IPRIGI, IPMASS
  50 : 
  51 : ******
  52 : *     -- VARIABLES LOCALES --
  53 : ***
  54 :       SEGMENT MATRED
  55 :          REAL*8 MATVEC (N, N),MATVE1(N,N), XMAT(N, N)
  56 :       END SEGMENT
  57 :       POINTEUR IPLCH1.MLCHPO
  58 :       INTEGER ILDIM, N       
  59 : 
  60 : ******
  61 : *     INITIALISATIONS                    
  62 : ***    
  63 : 
  64 :       SEGACT ,IPLVEC
  65 :       ILDIM = IPLVEC.ICHPOI( /1 )
  66 :       N1 = ILDIM
  67 :       SEGINI ,IPLCH1
  68 :       DO 95 IB95 = 1, ILDIM
  69 :          IPCHPO = IPLVEC.ICHPOI(IB95) 
  69 :          CALL COPIE2 ( IPCHPO, IPCHP1 )
  70 :          IF ( IERR .NE. 0 ) RETURN
  71 :          IPLCH1.ICHPOI(IB95)  = IPCHP1
  72 :  95   CONTINUE
  73 :       SEGDES ,IPLVEC
  74 :       SEGACT  MATRED*MOD
  75 :       
  76 : ******
  77 : *     CALCUL DES FACTEURS DE LA MATRICE      
  78 : ***
  79 :       DO 100 IB100 = 1, ILDIM
  80 :          IPCHPO = IPLCH1.ICHPOI(IB100)
  80 :          CALL MTREDU ( IPCHPO, IPRIGI, IPMASS, IPRES)
  81 :          
  82 :          DO 150 IB150 = 1, ILDIM
  83 :             IPCHP1 = IPLCH1.ICHPOI(IB150)
  83 :             CALL XTY1 (IPCHP1, IPRES, IPLMOX,
  84 :      &           IPLMOX, XRES )
  85 :             IF (IERR .NE. 0) RETURN
  86 :             
  87 :             XMAT(IB150, IB100) = XRES
  88 : *            write(6,*)'matrice reduite', xres
  89 :  150     CONTINUE
  89 :          CALL DTCHPO(IPRES)
  90 :  100  CONTINUE     
  91 :  
  92 : *     ON VIDE LA MEMOIRE
  93 :       SEGSUP IPLCH1
  94 :       
  95 :       END
  96 :  
  97 :