Sources Esope | Cast3M

fofiss
C FOFISS    SOURCE    CB215821  23/01/25    21:15:14     11573          
C
      SUBROUTINE FOFISS
C
C=======================================================================
C
C            OPERATEUR FORCES INTERNES
C
C          CET OPERATEUR NOUS PERMET DE CALCULER LE CHPOIN FOR1
C          DES FORCES NODALES RESULTANT DE L'INTEGRATION DU CHA-
C          MELEM SIG1 DE CONTRAINTES ISSU PAR EXEMPLE DE L'OPE-
C          RATEUR  SIGMA  ET DU CHAMELEM GRAD1 DE GRADIENTS ( ET
C          GRAF1 DE GRAFLEXIS ) ISSU PAR EXEMPLE DE L'OPERATEUR
C          GRAD ( ET GRAF ).
C
C          SYNTAXE  : FOR1=FOFISS MOD1 SIG1 GRAD1 (GRAF1)(CAR1)  ;
C
C         ENTREES :
C                MOD1=OBJET DE TYPE MMODEL
C                SIG1=CHAPM /ELMTS DE CONTRAINTES (TYPE MCHAML)
C                GRAD1=CHAPM /ELMTS DE GRADIENTS  (TYPE MCHAML)
C                GRAF1=CHAPM /ELMTS DE GRAFLEXIS  (TYPE MCHAML)
C                CAR1=CHAMP /ELMTS DE CARACTERISTIQUES (FACULTATIF)
C                POUR LES POUTRES ET LES COQUES (TYPE MCHAML)
C         SORTIES:
C                  FOR1 =CHAMP PAR POINT DONNANT LES FORCES NODALES
C    CODE JUILLET 87 SUO X.Z.
C    PASSAGE AUX NOUVEAUX MCHAMLS PAR P.DOWLATYARI SEP 91
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
 
-INC SMCOORD
-INC PPARAM
-INC CCOPTIO
C
       IPMODL=0
       IPCHE1=0
       IPCHE2=0
       IPCHE3=0
       IPCHE4=0
       IPCHA3=0
       IPCHA4=0
C
C  ****  LECTURE D'UN OBJET MMODEL
C
       CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
       CALL ACTOBJ('MMODEL',IPMODL,1)
       IF(IERR.NE.0)RETURN
C
C  ****  LECTURE DU PREMIER CHAMP/ELEMENT
C
        CALL LIROBJ('MCHAML',IPIN,1,IRT1)
        CALL ACTOBJ('MCHAML',IPIN,1)
        IF(IERR.NE.0)RETURN
        CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
C
C  ****  LECTURE DU DEUXIEME CHAMP/ELEMENT
C
        CALL LIROBJ('MCHAML',IPIN,1,IRT1)
        CALL ACTOBJ('MCHAML',IPIN,1)
        IF(IERR.NE.0) RETURN
        CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
C
C  ****  LECTURE EVENTUELLE DU TROISIEME CHAMP
C
        CALL LIROBJ('MCHAML',IPIN,0,IRT1)
        IF(IERR.NE.0)RETURN
        IPCHA3=0
        IF (IRT1 .EQ. 1) THEN
          CALL ACTOBJ('MCHAML',IPIN,1)
          CALL REDUAF(IPIN,IPMODL,IPCHA3,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
        ENDIF
C
C  ****  LECTURE EVENTUELLE DU QUATRIEME CHAMP
C
        CALL LIROBJ('MCHAML',IPIN,0,IRT1)
        IF(IERR.NE.0)RETURN
        IPCHA4=0
        IF (IRT1 .EQ. 1) THEN
        CALL ACTOBJ('MCHAML',IPIN,1)
          CALL REDUAF(IPIN,IPMODL,IPCHA4,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
        ENDIF
C
       IF (IPCHA3.NE.0.OR.IPCHA4.NE.0) THEN
         CALL RNGCHA(IPCHA3,IPCHA4,'GRAFLEXI',
     1                            'CARACTERISTIQUES',IPCHE3,IPCHE4)
         IF(IERR.NE.0) RETURN
       ENDIF
C
      SEGACT,MCOORD
      CALL FOFIS1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHP1,IRET)
      SEGDES,MCOORD
      IF(IERR.NE.0) RETURN
C
      IF(IRET.EQ.1) THEN
        CALL ACTOBJ('CHPOINT ',IPCHP1,1)
        CALL ECROBJ('CHPOINT ',IPCHP1)
      ENDIF
 
      END