Sources Esope | Cast3M

sigsol
C SIGSOL    SOURCE    CB215821  24/04/12    21:17:14     11897          
      SUBROUTINE SIGSOL
C_______________________________________________________________________
C
C  Operateur contraintes lineaires pour objet solution
C
C
C  SYNTAXE :
C  _________
C
C    SOL1 = SIGSOL MODL1 MAT1 ( CAR1 ) SOLUT ;
C
C         MAT1     Champ de CARACTERISTIQUES ou de HOOKE (type MCHAML )
C         CAR1     Champ de CARACTERISTIQUES     (type MCHAML)
C         SOLUT    OBJET solution (ne contenant pas de contraintes )
C
C       FEVRIER 87 BROCHARD :
C         - LE CALCUL EFFECTIF EST FAIT DANS SIGMAP
C
C  Passage aux nouveaux CHAMELEMS par I.Monnier le 3.07.90
C_______________________________________________________________________
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCHPOI
-INC SMSOLUT
-INC SMMODEL
*
      LOGICAL L0,L1
      CHARACTER*8 MOMOD,MOSTA,MOPSM,CTYP,TYPRET,CHARRE
      CHARACTER*40 TYPBAS
      CHARACTER*72 CTEXT
      PARAMETER(XZER=0.D0,UNDEMI=.5D0,UN=1.D0)
      PARAMETER(IZERO=0,IUN=1)
      DATA MOMOD,MOSTA,MOPSM/'MODE    ','SOLUSTAT','PSEUMODE'/
      INTEGER N1
*
*           IPOI11 IRT11   OBJERT SOLUTION NE CONTENANT PAS DE
*                          CONTRAINTES
*           IPOI1 IRT1     POINTEUR CHPO DEPL. OBJET SOLUTION
*
 
************************************************************************
*     INITIALISATIONS et VERIFICATION
************************************************************************
*
      N1 = 0
      IPCHA1=0
      IPCHA2=0
      IPCHE1=0
      IPCHE2=0
 
c *     verification de l'option de calcul des deformations
c       IF(MEPSIL.NE.1) THEN
c       CALL ERREUR(1037)
c       RETURN
c       ENDIF
cbp, 2020-12-10 : ci dessus n'a plus lieu d'etre car SIGSOL travaille 
c                 toujours en hypothese de deformations lineaires
 
 
************************************************************************
*     LECTURE DES MODELE et MCHAML
************************************************************************
*
C     LECTURE DU MODELE
C
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
 
c *     verification de l'option de calcul des deformations du modele
c       MMODEL=IPMODL
c       SEGACT,MMODEL
c       NSOUS=KMODEL(/1)
c       IF(N1.LE.0) GOTO 09
c       DO 01 ISOUS=1,NSOUS
c         IMODEL=KMODEL(ISOUS)
c         SEGACT,IMODEL
c         IF(IDERIV.NE.1)THEN
c       WRITE(IOIMP,*)'L OPERATEUR SIGS SUPPOSE DES PETITES PERTURBATIONS'
c       WRITE(IOIMP,*)'VOUS POUVEZ CHOISIR DES DEFORMATIONS LINEAIRES VIA'
c      & ,' LA COMMANDE :'
c       WRITE(IOIMP,*)'    OPTI EPSI LINEAIRE;'
c       WRITE(IOIMP,*)'PLACÉ AVANT LA CONSTRUCTION DES MODELES'
c       WRITE(IOIMP,*)'OU LORS DE LA CREATION DES MODELES VIA :'
c       WRITE(IOIMP,*)'    MODL1 = MODE ... EPSI LINEAIRE ...;'
c           CALL ERREUR(1037)
c           SEGDES,IMODEL
c           GOTO 02
c         ENDIF
c         SEGDES,IMODEL
c  01   CONTINUE
c  02   SEGDES,MMODEL
c       IF(IERR.NE.0) RETURN
c  09   CONTINUE
cbp, 2020-12-10 : ci dessus n'a plus lieu d'etre car SIGSOL travaille 
c                 toujours en hypothese de deformations lineaires
C
C     LECTURE DU 1ER MCHAML
C
      CALL LIROBJ('MCHAML  ',IPIN,1,IRT1)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF (IERR.NE.0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
C
C     LECTURE DU 2EME MCHAML
C
      CALL LIROBJ('MCHAML  ',IPIN,0,IRT1)
      IF (IERR.NE.0) RETURN
      IPCHA2=0
      IF (IRT1 .EQ. 1) THEN
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
      ENDIF
C
      CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES',
     1                          'MATRICE DE HOOKE',IPCHE1,IPCHE2)
      IF (IERR.NE.0) RETURN
      IF (IPCHE2.EQ.0) THEN
        IMAT=1
      ELSE
        IMAT=2
      ENDIF
 
 
************************************************************************
*     LECTURE D'UNE TABLE OU D'UN OBJET SOLUTION
************************************************************************
*
      CALL QUETYP(CTYP,IUN,IRETOU)
 
***** CAS D UNE TABLE **************************************************
      IF (CTYP(1:8).EQ.'TABLE   ') THEN
         CALL LIRTAB('BASE_MODALE',ITBAS,IZERO,IRET)
         IF (IRET.EQ.0) THEN
            CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,IUN,IRET)
         ENDIF
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
     &                     'MOT',I1,X1,TYPBAS,L1,IP1)
*
*        Cas ou la base est unique
*
         IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
*
*           On recupere la base de modes
*
            CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
     &                      'TABLE',I1,X1,' ',L1,IBAS)
            CALL SIGTAB('MODE',IBAS,IPCHE1,IPCHE2,IMAT,IPMODL)
            TYPRET = ' '
            CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
     &                       TYPRET,I1,X1,CHARRE,L1,ITPS)
            IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
              CALL SIGTAB('PSMO',ITPS,IPCHE1,IPCHE2,IMAT,IPMODL)
            ENDIF
*
*        Cas ou on a un ensemble de bases
*
         ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
*
*           On boucle sur le nombre de bases
*
            IB = 0
 10         CONTINUE
            TYPRET = ' '
            IB = IB + 1
            CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
     &                          TYPRET,I1,X1,CHARRE,L1,ITTBAS)
            IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
               CALL ACCTAB(ITTBAS,'MOT',I0,X0,'MODES',L0,IP0,
     &                          'TABLE',I1,X1,' ',L1,IBAS)
               CALL SIGTAB('MODE',IBAS,IPCHE1,IPCHE2,IMAT,IPMODL)
               TYPRET = ' '
               CALL ACCTAB(ITTBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
     &                           TYPRET,I1,X1,CHARRE,L1,ITPS)
               IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
                 CALL SIGTAB('PSMO',ITPS,IPCHE1,IPCHE2,IMAT,IPMODL)
               ENDIF
               GOTO 10
            ENDIF
         ENDIF
         CALL ECROBJ('TABLE   ',ITBAS)
         RETURN
      ENDIF
 
 
***** CAS D UNE SOLUTION ***********************************************
*     version appelee @ disparaitre...?
      CALL LIROBJ('SOLUTION',IPOI11,IUN,IRT11)
      IF(IERR.NE.0) RETURN
C
C     CALCUL DES CONTRAINTES  BOUCLES SUR LES MODES
C     OU LES SOLUTIONS STATIQUES OU LES PSEUDO-MODES.
C
      MSOLUT=IPOI11
      SEGACT MSOLUT
C
C     IMOD = 0 ERREUR, = 1 MODE, = 2 SOLUSTAT, = 3 PSEUMODE
C
      IMOD=0
      IF(ITYSOL.EQ.'MODE    ') IMOD=1
      IF(ITYSOL.EQ.'SOLUSTAT') IMOD=2
      IF(ITYSOL.EQ.'PSEUMODE') IMOD=3
      IF(IMOD.NE.0) GOTO 110
      MOTERR(1:8)='SOLUTION'
      CALL ERREUR(302)
      RETURN
C
110   CONTINUE
      MSOLEN=MSOLIS(5)
      SEGACT MSOLEN
      N=ISOLEN(/1)
      SEGINI MSOLE1
      DO 200 ICHO=1,N
         IPOI1=ISOLEN(ICHO)
         MCHPOI = IPOI1
         SEGACT MCHPOI
         CTEXT = MOCHDE
         SEGDES MCHPOI
         IRT1=1
         IRT8=0
         IPOI6=0
         IRT6=0
         IRT9=0
         inoer=0
c        calcul lineaire des contraintes
         CALL SIGMAP(0,IPMODL,IPOI1,IPCHE1,IPCHE2,IMAT,IPOI8,IRET,inoer)
         IF(IRET.EQ.0) GOTO 210
         MSOLE1.ISOLEN(ICHO)=IPOI8
200   CONTINUE
C
C     CREATION DU NOUVEL OBJET SOLUTION
C
      SEGDES MSOLE1,MSOLEN
      NIPO=MSOLIS(/1)
      IF(NIPO.LE.6) NIPO=6
      SEGINI MSO1
      MSO1.ITYSOL=ITYSOL
C
      DO 201 IPO=1,NIPO
      MSO1.MSOLIS(IPO)=MSOLIS(IPO)
      MSO1.MSOLIT(IPO)=MSOLIT(IPO)
201   CONTINUE
      MSO1.MSOLIS(6)=MSOLE1
      MSO1.MSOLIT(6)=5
      SEGDES MSO1,MSOLUT
C
C     ECRITURE DU NOUVEL OBJET SOLUTION
C
      CALL ECROBJ('SOLUTION',MSO1)
      RETURN
C
C     ON N A PAS PU CREER UN CHAMELEM DE CONT. ON DETRUIT
C     LE NOUVEL OBJET SOLUTION
 
210   CONTINUE
      SEGSUP MSOLE1
      SEGDES MSOLEN,MSOLUT
 
      END