Esope source files

   1 : C SESPA5    SOURCE    CHAT      05/01/13    03:14:45     5004           
   2 : C SESPA5    SOURCE    WP        23/08/94                
   3 : C     SUBROUTINE SESPA5 ( IPLVA1, IPLVA2, IPLCH1, IPLCH2,
   4 : C    1                    IPMASS, BOOL, NBMOD )
   5 : ************************************************************************        
   6 : *                                                                               
   7 : *                                SESPA5                                        
   8 : *                             -----------                                       
   9 : *                                                                               
  10 : * FONCTION:                                                                     
  11 : * ---------                                                                     
  12 : *                                                                               
  13 : *     ON TEST LA CONVERGENCE DES ELEMENTS PROPRES:
  14 : *                -  TEST SUR LA VALEUR PROPRE.
  15 : *                -  TEST SUR LA MASSE GENERALISEE.
  16 : *
  17 : * MODE D'APPEL:                                 
  18 : * -------------
  19 : *                                                                               
  19 : *     CALL  SESPA5 ( IPLVA1,IPLVA2,IPLCH1,IPLCH2,IPMASS,BOOL,NBMOD )
  20 : *                                                                               
  21 : * AUTEUR, DATE DE CREATION:                                                     
  22 : * -------------------------                                                     
  23 : *                                                                               
  24 : *   A.M. JOLIVALT,  W. PASILLAS   29 / 07 / 94.   ( ESOPE )                                     
  25 : *                                                                               
  26 : ************************************************************
  27 : 
  28 :       SUBROUTINE SESPA5 ( IPLVA1, IPLVA2, IPLCH1, IPLCH2, 
  29 :      1                    IPMASS, BOOL, NBMOD )   
  30 : 
  31 :       IMPLICIT INTEGER(I-N)
  32 :       IMPLICIT REAL*8 (A-H,O-Z)
  33 : 
  34 : -INC  CCOPTIO

  35 : -INC  SMLREEL

  36 : -INC  SMLCHPO

  37 : 
  38 : ******
  39 : *     -- CONSTANTES --
  40 : ***
  41 :       PARAMETER ( PRECI1 = 1.0D-6 )                                                
  42 :       PARAMETER ( PRECI2 = 1.0D-6 )  
  43 : 
  44 : ******
  45 : *     -- ARGUMENTS --
  46 : ***
  47 :       POINTEUR IPLVA1.MLREEL, IPLVA2.MLREEL
  48 :       POINTEUR IPLCH1.MLCHPO, IPLCH2.MLCHPO
  49 :       INTEGER  NBMOD, IPMASS
  50 :       LOGICAL  BOOL 
  51 : 
  52 : ******
  53 : *     -- VARIABLES LOCALES --
  54 : ***
  55 :       INTEGER  IB100
  56 :       REAL*8   ALPHA1, ALPHA2, RESIDU
  57 : 
  58 : 
  59 : ******
  60 : *     -- ON TRIE LES LISTES ( VOIR ORDVEC ) --
  61 : ***
  61 :       CALL ORDVEC ( IPLVA1, IPLCH1 )
  62 :       IF ( IERR .NE. 0 ) RETURN 
  62 :       CALL ORDVEC ( IPLVA2, IPLCH2 )
  63 :       IF ( IERR .NE. 0 ) RETURN 
  64 : 
  65 :       SEGACT ,IPLVA1, IPLVA2, IPLCH1, IPLCH2
  66 : 
  67 : 
  68 :       BOOL = .TRUE.
  69 : 
  70 :       DO 100 IB100 = 1, NBMOD
  71 : ******
  72 : *        -- CONVERGENCE DE LA VALEUR PROPRE --
  73 : ***
  74 :          ALPHA1 = IPLVA1.PROG( IB100 )
  75 :          ALPHA2 = IPLVA2.PROG( IB100 )
  76 :          RESIDU = ABS( ALPHA2 - ALPHA1 )
  77 :          IF ( RESIDU .GT. PRECI1 * ABS(ALPHA2) ) THEN
  78 :             BOOL = .FALSE.
  79 :             GOTO 110
  80 :          ELSE
  81 : ******
  82 : *           -- CONVERGENCE DE LA MASSE GENERALISEE --    
  83 : ***
  84 :             IPCHP1 = IPLCH1.ICHPOI( IB100 )
  85 :             IPCHP2 = IPLCH2.ICHPOI( IB100 )
  85 :             CALL XTMX ( IPCHP1, IPMASS, ALPHA1 )
  86 :             IF ( IERR .NE. 0 ) RETURN 
  86 :             CALL XTMX ( IPCHP2, IPMASS, ALPHA2 )
  87 :             IF ( IERR .NE. 0 ) RETURN 
  88 :             RESIDU = ABS( 1.0D0 - ABS( ALPHA1 / ALPHA2 )  )
  89 :             IF ( RESIDU .GT. PRECI2 ) THEN
  90 :                BOOL = .FALSE.
  91 :                GOTO 110
  92 :             ENDIF
  93 :          ENDIF
  94 :  100  CONTINUE
  95 :  110  CONTINUE
  96 : 
  97 :       SEGDES ,IPLVA1, IPLVA2, IPLCH1, IPLCH2 
  98 : 
  99 :       RETURN
 100 :       END
 101 :  
 102 :