Esope source files

   1 : C DIAGN1    SOURCE    PV        13/02/15    21:15:01     7699           
   2 :       SUBROUTINE DIAGN1 (IPRIGI,INFER0)                                         
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             D I A G N 1                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     EXECUTER LA FONCTION ATTRIBUEE A L'OPERATEUR "DIAGNEG".                   
  12 : *                                                                               
  13 : * MODE D'APPEL:                                                                 
  14 : * -------------                                                                 
  15 : *                                                                               
  15 : *     CALL DIAGN1 (IPRIGI,INFER0)                                               
  16 : *                                                                               
  17 : * PARAMETRES:  (E)=ENTREE   (S)=SORTIE                                          
  18 : * -----------                                                                   
  19 : *                                                                               
  20 : *     IPRIGI  ENTIER    (E)  POINTEUR D'UNE 'RIGIDITE'.                         
  21 : *     INFER0  ENTIER    (S)  NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA          
  22 : *                            MATRICE DIAGONALE "D" DE LA 'RIGIDITE'             
  23 : *                            DECOMPOSEE EN "L.D.LT"                             
  24 : *                                                                               
  25 : * AUTEUR, DATE DE CREATION:                                                     
  26 : * -------------------------                                                     
  27 : *                                                                               
  28 : *     PASCAL MANIGOT     8 OCTOBRE 1984                                         
  29 : *                                                                               
  30 : * LANGAGE:                                                                      
  31 : * --------                                                                      
  32 : *                                                                               
  33 : *     ESOPE + FORTRAN77                                                         
  34 : *                                                                               
  35 : ************************************************************************        
  36 : *                                                                               
  37 :       IMPLICIT INTEGER(I-N)
  38 : -INC CCOPTIO                                                                    
  39 : -INC SMMATRI                                                                    
  40 : -INC SMRIGID                                                                    
  41 : -INC SMTABLE
  42 : * 
  43 :       integer insym
  44 :       isupt = 0
  45 :       insym = 0
  46 :       MRIGID = IPRIGI                                                           
  47 :       SEGACT,MRIGID 
  48 :       isupt = isupeq
  49 : *     write (6,*) ' isupeq 1 ',isupeq
  50 :       ipoiri = jrcond
  51 :       if (ipoiri.ne.0) then
  52 :        mrigid = ipoiri
  53 :        segact mrigid
  54 :        if (isupt.eq.0) isupt = isupeq
  55 : *     write (6,*) ' isupoq 2 ',isupeq
  56 :       endif
  57 :       NRG = IRIGEL(/1)
  58 :       NBR = IRIGEL(/2)
  59 :       if (nbr.eq.0) then
  60 :        infer0 = 0
  61 :        segdes mrigid
  62 :        return
  63 :       endif
  64 :       IPMATR = ICHOLE
  65 :       IF(NORINC.GT.0  .AND. NORIND.GT.0) THEN
  66 :          INSYM = 1
  67 :       ENDIF
  68 :       IF (NRG.GE.7) THEN
  69 :          DO  9 IN = 1,NBR
  70 :             IANTI=IRIGEL(7,IN)
  71 :             IF(IANTI.GT.0) THEN
  72 :                INSYM = 1
  73 :             ENDIF
  74 :   9      CONTINUE
  75 :       ENDIF                                                           
  76 :       SEGDES,MRIGID                                                       
  77 : *                                                                               
  78 :       if (isupt.eq.0) then
  79 :       IF (IPMATR .EQ. 0) THEN
  80 :         IF (INSYM .EQ. 0) THEN
  80 :          CALL TRIANG (mrigid,1D-18)
  81 :         ELSE
  81 :          CALL ldmt1(mrigid,1d-18)
  82 :         ENDIF
  83 :          IF (IERR .NE. 0) RETURN                                                
  84 :          MRIGID = IPRIGI                                                        
  85 :          SEGACT,MRIGID                                                          
  86 :          IPMATR = ICHOLE                                                        
  87 :          SEGDES,MRIGID                                                    
  88 :       END IF                                                                    
  89 : *                                                                               
  90 :       MMATRI = IPMATR                                                           
  91 :       SEGACT,MMATRI                                                             
  92 :       INFER0 = INEG                                                             
  93 :       SEGDES,MMATRI                                                       
  94 :       else
  95 :        mtable = isupt
  96 :        segact mtable
  96 :          CALL ACCTAB(mtable,'ENTIER',13,0.d0,' ',.true.,IP0,
  97 :      &                   'ENTIER',infer0,X1,CHARRE,.true.,ITMOD)
  98 : **     write (6,*) ' unilateral nbneg ',infer0
  99 :        segdes mtable
 100 :       endif
 101 : *                                                                               
 102 :       END                                                                       
 103 :  
 104 :  
 105 :  
 106 :  
 107 :  
 108 :  
 109 :  
 110 :  
 111 :  
 112 :  
 113 :  
 114 :  
 115 :  
 116 :