Esope source files

   1 : C PRINCI    SOURCE    CHAT      06/08/24    21:59:58     5529           
   2 :       SUBROUTINE PRINCI                                                         
   3 : C=======================================================================        
   4 : C                                                                               
   5 : C             CALCUL DE CHAMP DE CONTRAINTES PRINCIPALES                        
   6 : C                                                                               
   7 : C                                                                               
   8 : C     CHAM2 = PRINCI CHAM1  (CAR1) MODL (MOTCL);                                
   9 : C                                                                               
  10 : C     MOTCL =  'SUP ' OU 'INF ' OU 'MOYE'  POUR LES COQUES
  11 : C                     OU 'TRID' POUR LES MASSIFS
  12 : C     CAR1  =  objet de type  MCHAML    de sous type CARACTERISTIQUES           
  13 : C     CHAM1 =  objet de type  MCHAML    de sous type CONTRAINTES                
  14 : C                                                 ou DEFORMATIONS               
  15 : C     MODL  =  objet de type  MMODEL                                            
  16 : C     CHAM2 =  objet de type  MCHAML    de sous type CONTRAINTES                
  17 : C                                                    PRINCIPALES                
  18 : C                                                                               
  19 : C     Passage au nouveau Chamelem par S.RAMAHANDRY le 21/09/90                  
  20 : C                                                                               
  21 : C=======================================================================        
  22 :       IMPLICIT INTEGER(I-N)
  23 : -INC CCOPTIO                                                                    
  24 :       CHARACTER*4 MMM                                                           
  25 : C                                                                               
  26 : C                                                                               
  27 : C           IPMODL          MODELE MMODEL                                       
  28 : C           IPCHA1          CHAMELEM  CONTRAINTES ou DEFORMATIONS               
  29 : C           IPCHA2          CHAMELEM  CARACTERISTIQUES                          
  30 : C           IPCHE1          MCHAML  CONTRAINTES ou DEFORMATIONS                 
  31 : C           IPCHE2          MCHAML  CARACTERISTIQUES                            
  32 : C           IPSTRS          MCHAML  CONTRAINTES  PRINCIPALES                    
  33 : C                                                                               
  34 :       IPCHA1=0                                                                  
  35 :       IPCHA2=0                                                                  
  36 :       IPCHE1=0                                                                  
  37 :       IPCHE2=0                                                                  
  38 :       IPMODL=0                                                                  
  39 :       IPSTRS=0                                                                  
  40 :       IRTM  =0                                                                  
  41 : C                                                                               
  42 : C     LECTURE D'UN MOT CLEF                                                     
  43 : C                                                                               
  43 :       CALL LIRCHA(MMM,0,IRT0)                                                   
  44 :       IF(IRT0.EQ.0) MMM='MOYE'                                                  
  45 : C                                                                               
  46 : C     LECTURE D'UN MODEL                                                        
  47 : C                                                                               
  47 :       CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
  48 :       IF(IERR.NE.0) RETURN
  49 : C ----------------------------------------------------------------------        
  50 : C                   SI ANCIENNE SYNTAXE                                         
  51 : C ----------------------------------------------------------------------        
  52 : C                                                                               
  53 : C        LECTURE D' UN PREMIER MCHAML (CONTRAINTE)                              
  54 : C                                                                               
  54 :          CALL LIROBJ('MCHAML',IPCHE1,1,IRT1)                                    
  55 :          IF(IERR.NE.0) RETURN                                                   
  56 :          IF(IRT1.EQ.0) GOTO 666                                                 
  57 : C                                                                               
  58 : C        LECTURE D' UN DEUXIEME MCHAML (CARACTERISTIQUE)                        
  59 : C                                                                               
  59 :          CALL LIROBJ('MCHAML',IPCHE2,0,IRT2)                                    
  60 :          IF(IERR.NE.0) RETURN                                                   
  61 : C                                                                               
  62 : C                                                                               
  63 : C                    APPEL A PRINPO                                             
  64 : C                    ==============                                             
  65 : C                                                                               
  65 :       CALL PRINPO(IPCHE1,MMM,IPCHE2,IPMODL,IPSTRS,IRET)                         
  66 : C ----------------------------------------------------------------------        
  67 : C                   ECRITURE DU RESULTAT                                        
  68 : C ----------------------------------------------------------------------        
  69 : C                                                                               
  70 : C                                                                               
  71 :       IF(IRET.EQ.0.OR.IERR.NE.0) GOTO 666                                       
  72 : C                                                                               
  72 :          CALL ECROBJ('MCHAML',IPSTRS)                                           
  73 : C                                                                               
  74 :   666 CONTINUE                                                                  
  75 :       RETURN                                                                    
  76 :       END                                                                       
  77 :  
  78 :  
  79 :  
  80 :