Esope source files

   1 : C EQUIV     SOURCE    CHAT      11/03/16    21:21:25     6902           
   2 :       SUBROUTINE EQUIV
   3 : C=======================================================================C
   4 : C                                                                       C
   5 : C     OPERATEUR DE RIGIDITE POUR LES STRUCTURES EN BETON PRECONTRAINTES C
   6 : C                                                                       C
   7 : C     ENTREES:                                                          C 
   8 : C                                                                       C
   9 : C        MODL           MODELE POUR LE BETON                            C
  10 : C        MODL1          MODELES DES ACIERS                              C
  11 : C        MATR           CHARACTERISTIQUES MECANIQUES DES MATERIAUX      C
  12 : C                                                                       C
  13 : C     SORTIES :                                                         C
  14 : C                                                                       C
  15 : C       POINTEUR IPOI6  CREER UN OBJET DE RIGIDITE                      C
  16 : C                                                                       C
  17 : C-----------------------------------------------------------------------C
  18 : C             Fichier JIANG modifié FLEURET 05/96                       C
  19 : C=======================================================================C
  20 :       IMPLICIT INTEGER(I-N)
  21 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  22 : -INC CCOPTIO                                                                    
  23 : -INC CCHAMP                                                                     
  24 : -INC SMCHAML
  25 : -INC SMELEME
  26 : -INC SMMODEL
  27 : -INC SMCHPOI
  28 : C
  29 :       SEGMENT IPNN
  30 :         INTEGER IPNNUM(NSOU1)
  31 :       ENDSEGMENT
  32 : C
  33 :       DIMENSION IPM(200)    
  34 :       CHARACTER*4 CMOT  
  35 :       CHARACTER*6 CMOT1
  36 :       IPCHE1=0                                                                  
  37 :       IPCHE2=0                                                                  
  38 : C
  39 : C --- ON RECUPERE EVENTUELLEMENT DES OBJETS MODELE
  40 : C
  41 :       DO 10 I=1,200
  42 :  10   IPM(I)=0
  42 :       CALL LIRCHA(CMOT1,0,IRETOU)
  43 :       NOMCA=1
  44 :       IMD=NOMCA+1
  45 :       DO 11 I=1,IMD
  46 :       IPMODL=0 
  46 :       CALL LIROBJ('MMODEL',IPMODL,0,IRET)
  47 :  11   IPM(I)=IPMODL
  48 :       MMODEL =IPM(2)
  49 :       SEGACT MMODEL                                                     
  50 :       NSOU1=KMODEL(/1) 
  51 : C      SEGINI IPNN
  52 : C
  53 :       IF(CMOT1.EQ.'RIGI') THEN                                   
  54 : C                                                                               
  55 : C --- ON LIT UN 1-ER CHAMELEM
  56 : C                                                                               
  57 :       IPCHA1 = 0                                                                
  57 :       CALL LIROBJ('MCHAML',IPCHA1,1,IRET1)
  58 :       IF (IERR.NE.0) RETURN                                                     
  59 : C                                                                               
  60 : C --- ON LIT EVENTUELLEMENT UN 2EME CHAMELEM                                   
  61 : C                                                                               
  62 :       IPCHA2 = 0                                                                
  62 :       CALL LIROBJ('MCHAML',IPCHA2,0,IRET1)  
  63 : C                                                                               
  64 : C --- RANGEMENT DES POINTEURS :  'CARACTERISTIQUES' DANS IPCHE1           
  65 : C                                'MATRICE DE HOOKE' DANS IPCHE2              
  66 : C                                                                               
  66 :         CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES','MATRICE DE HOOKE',      
  67 :      1              IPCHE1,IPCHE2)                
  68 :         IF ( IERR.NE.0) RETURN                         
  69 :         IF (IPCHE2.NE.0) THEN                 
  70 :           IMAT = 2                            
  71 :         ELSE IF (IPCHE1.NE.0) THEN             
  72 :           IMAT = 1                         
  73 :         ELSE                             
  74 :           IPCHE1=IPCHA1                    
  75 :           IMAT = 1                      
  76 :         ENDIF
  77 :       ELSE IF(CMOT1.EQ.'FORCES') THEN
  78 :         IPCHEP=0 
  78 :         CALL LIROBJ('MCHAML',IPCHEP,0,IRET)
  79 :       END IF
  80 : C                                                                               
  81 : C --- APPEL AU CALCUL DES RIGIDITES ELEMENTAIRES
  82 : 
  83 : 
  84 : C                                                                               
  85 :  2000 CONTINUE                                                                  
  85 :        CALL SUBNNM(IPM,IPNN,IMD,IRET)
  86 :       IF(CMOT1.EQ.'RIGI') THEN
  86 :         CALL RIGIA(IMD,IPCHE1,IPCHE2,IMAT,IPOI6,IPM,IPNN,IRET)
  86 :         IF (IRET.EQ.1) CALL ECROBJ('RIGIDITE',IPOI6) 
  87 :       ELSE IF(CMOT1.EQ.'FORCES') THEN
  87 :         CALL LSIGMP(IMD,IPCHEP,IPCHE2,IPCHE3,IMAT,
  88 :      &     IPCHE4,IRET,IPM,IPNN,IPCHE)          
  89 :         IF (IRET.EQ.1) THEN                                                    
  90 : C 
  91 : C --- ATTRIBUTION D'UNE NATURE DISCRETE AU CHPO QUI SORT
  92 : C
  93 :           MCHPOI = IPCHE4
  94 :           SEGACT MCHPOI*MOD
  95 :           JATTRI(1) = 2
  96 :           SEGDES MCHPOI
  96 :           CALL ECROBJ('CHPOINT',IPCHE4)                                   
  97 :       END IF                              
  98 :       END IF
  99 :       SEGSUP IPNN
 100 :       END                                                                       
 101 :  
 102 :  
 103 :  
 104 :  
 105 :  
 106 :  
 107 :  
 108 :  
 109 :  
 110 :  
 111 :  
 112 :