Esope source files

   1 : C ITERED    SOURCE    CHAT      05/01/13    00:44:13     5004           
   2 : C     SUBROUTINE ITERED ( MATRED, ILDIM)
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                                ITERED                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     REALISE LES ITEREATION SUR LE SOUS-ESPACE GENERE PAR IPLVEC AVEC LE SYSTEME
  12 : *     REDUIT MATRED. 
  13 : *
  14 : * MODE D'APPEL:                                 
  15 : * -------------
  16 : *                                                                               
  16 : *     CALL ITERED ( MATRED, ILDIM,)
  17 : *                                                                               
  18 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  19 : * -----------                                                                   
  20 : *
  21 : *     MATRED  TABLEAU   (E)  TABLEAU CONTENANT LES COORDONNEES
  22 : *                            DU SYSTEME REDUIT
  23 : *
  24 : *     IPRIGI  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' K
  25 : *     IPMASS  ENTIER    (E)  POINTEUR SUR L'OBJET 'RIGIDITE' M
  26 : * 
  27 : *
  28 : * AUTEUR, DATE DE CREATION:                                                     
  29 : * -------------------------                                                     
  30 : *                                                                               
  31 : *   C. LE BIDEAU  09 / 2001  ( FORTRAN + ESOPE )                                       
  32 : *
  33 : ***********************************************************************
  34 : 
  35 :       SUBROUTINE ITERED (MATRED,ILDIM)
  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 : *     -- ARGUMENTS --
  46 : ***
  47 :       INTEGER  ILDIM, CONVRG 
  48 :       SEGMENT MATRED
  49 :          REAL*8 MATVEC (N, N),MATVE1(N,N), XMAT(N, N)
  50 :       END SEGMENT
  51 :       SEGMENT INTER
  52 :          REAL*8 RES(N4,N4)
  53 :       END SEGMENT
  54 :       
  55 : ******
  56 : *     INITIALISATION DE LA BASE D'ITERATIONS
  57 : ***
  58 :       N4 = ILDIM
  59 : *      write(6,*)'ildim = ', ILDIM
  60 :       SEGINI INTER
  61 : ******
  62 : *     PRODUIT MATRICE PAR LA BASE SOUS FORME DE MATRICE
  63 : *** 
  64 :       J=0
  65 :  1000 CONTINUE
  66 :       XD=0.D0
  67 : *** ON TRAVAILLE AVEC MATVEC GLISSEMENT
  68 :          DO 400 IB400=1, ILDIM
  69 :             DO 500 IB500 = 1, ILDIM
  70 :                XD=MATVEC(IB500,IB400)
  71 :                MATVE1(IB500,IB400)=XD
  72 :  500        CONTINUE
  73 :  400     CONTINUE                     
  74 :          DO 200 IB200 = 1, ILDIM
  75 :             DO 300 IB300 = 1, ILDIM
  76 :                XX=0.D0
  77 :                XP=0.D0
  78 :                DO 350 IB350= 1, ILDIM
  79 :                   XP=XMAT(IB300, IB350)*MATVEC(IB350, IB200)
  80 :                   XX = XX+ XP
  81 :  350           CONTINUE
  82 :                res(ib300,ib200)=xx
  83 :                
  84 :  300        CONTINUE
  85 :             
  86 :  200     CONTINUE
  87 :          DO 370 IB370=1,ILDIM
  88 :             DO 380 IB380=1, ILDIM
  89 :                XC=res(IB370, IB380)
  90 :                matvec(ib370,ib380)=XC
  91 :                
  92 :  380        CONTINUE
  93 :  370     CONTINUE
  94 : ******
  95 : *     ON REORTHONORMALISE APRES CHAQUE ITERATION
  96 : ***
  96 :          CALL ORTVEC (MATRED, ILDIM)
  97 :          do 600 ib600=1, ildim
  98 :             do 700 ib700=1,ildim
  99 :             tt=matvec(ib700,ib600)
 100 : *            if (j .gt. 5000) then
 101 : *                  WRITE(6,*)'MATRICE VECTEURS ', tt 
 102 : *            end if
 103 :  700        continue
 104 :  600     continue
 105 : ******
 106 : *     ON APPLIQUE LES CRITERES DE CONVERGENCE
 107 : ***
 107 :          CALL CONREL (MATRED, ILDIM, CONVRG,I)
 108 : 
 108 : **       CALL SUBROUTINE CRITERE COMPLEXE (MATRED, ILDIM, CONVRG)
 109 : 
 110 : ******
 111 : *     SI PAS DE CONVERGENCE ON FAIT GLISSER LES VECTEURS
 112 : *     ET ON RECOMMENCE JUSQU'A CONVERGENCE
 113 : ***      
 114 :         J=J+1
 115 : *         WRITE(6,*)'ITERATION REDUITE NUM ',J
 116 :          
 117 :          IF ( CONVRG .NE. 0) GOTO 1000
 118 :       
 119 :       
 120 :       SEGSUP INTER
 121 :       END
 122 :  
 123 :