Sources Esope | Cast3M

resi1
C RESI1     SOURCE    CB215821  25/04/23    21:15:38     12247          
 
************************************************************************
*
*                             R E S I 1
*                             ---------
*
* FONCTION:
* ---------
*     CREATION DE LA MATRICE DE RESISTANCE
*     GESTION DES SEGMENTS ET TESTS DE COMPATIBILITE
*
* PARAMETRES:  (E)=ENTREE    (S)=SORTIE
* -----------
*
*     IPMODE   (E)  POINTEUR SUR LE SEGMENT MMODEL (ACTIF EN E/S)
*     IPCHEL   (E)  POINTEUR SUR LE SEGMENT MCHELM (ACTIF EN E/S)
*     IPRIGI   (S)  POINTEUR SUR LE SEGMENT MRIGID (NOUVEAU EN S)
*
************************************************************************
 
      SUBROUTINE RESI1(IPMODE,IPCHEL,IPRIGI)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCHAMP
 
-INC SMRIGID
-INC SMCOORD
-INC SMCHAML
-INC SMELEME
-INC SMMODEL
 
      LOGICAL OK
 
      IPRIGI = 0
      IPCHE1 = 0
      IPMOD1 = 0
*
*       VERIFICATION DU LIEU SUPPORT DU CHAMELEM DE CARACTERISTIQUES
*
      CALL QUESUP(IPMODE,IPCHEL,2,0,ISUP,iretca)
      IF (ISUP.GT.1) RETURN
*
*     SI LE CHAMELEM EST APPUYE AUX NOEUDS, ON CHANGE LE SUPPORT
*     POUR LES CENTRES DE GRAVITE
*
      IF (ISUP.EQ.1) THEN
        CALL CHASUP(IPMODE,IPCHEL,IPCHE1,iret,2)
        IF (iret.NE.0) THEN
          CALL ERREUR(iret)
          RETURN
        ENDIF
      ELSE
        IPCHE1 = IPCHEL
      ENDIF
*
*     ANALYSE DU MMODEL
*
      MMODEL = IPMODE
      NBMAIL = mmodel.KMODEL(/1)
 
      N1 = NBMAIL
      SEGINI,mmode1
      IPMOD1 = mmode1
 
      N1 = 0
      DO imail = 1, NBMAIL
        IMODEL = mmodel.KMODEL(imail)
        NF1 = imodel.FORMOD(/2)
        CALL PLACE(imodel.FORMOD,NF1,IF1,'MAGNETODYNAMIQUE')
        OK = .FALSE.
        IF (IF1.NE.0) THEN
          NEF = imodel.NEFMOD
C-------- CAS DE L'ELEMENT ROT3
          IF (NEF.EQ.128) THEN
            OK = .TRUE.
          ELSE
            CALL ERREUR(19)
          ENDIF
        ENDIF
        IF (OK) THEN
          N1 = N1 + 1
          mmode1.KMODEL(N1) = IMODEL
        ENDIF
      ENDDO
      IF (N1.EQ.0) CALL ERREUR(251)
      IF (IERR.NE.0) GOTO 99
      NBMAIL = N1
*
*     INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE
*
      NRIGEL = NBMAIL
      SEGINI,MRIGID
      mrigid.MTYMAT = 'RIGIDITE'
      mrigid.IFORIG = IFOUR
*
*     BOUCLE SUR LES MAILLAGES ELEMENTAIRES, ZONE imail
*
      DO imail = 1, NBMAIL
*
        IMODEL = mmode1.KMODEL(imail)
        NEF    = imodel.NEFMOD
        MELEME = imodel.IMAMOD
        NBNN   = meleme.NUM(/1)
        NBELEM = meleme.NUM(/2)
 
*        REMPLIR LE SEGMENT DESCRIPTEUR DE L'OBJET RIGIDITE
*
        CALL RESI2(NEF,NBNN,IDESCR)
        descr = IDESCR
 
        NLIGRP = descr.noelep(/1)
        NLIGRD = descr.noeled(/1)
        NELRIG = NBELEM
 
        SEGINI,xMATRI
        IPMATR = xMATRI
 
        CALL ROT3R(NEF,MELEME,IMODEL,IPCHE1,IPMATR)
        IF (IERR.NE.0) GOTO 99
 
        COERIG(imail) = 1.D0
        IRIGEL(1,imail) = MELEME
        IRIGEL(2,imail) = 0
        IRIGEL(3,imail) = IDESCR
        IRIGEL(4,imail) = IPMATR
        IRIGEL(5,imail) = 0
        IRIGEL(6,imail) = 0
        IRIGEL(7,imail) = 0
        IRIGEL(8,imail) = 0
 
        SEGDES,descr,xMATRI
 
      ENDDO
 
      IPRIGI = MRIGID
 
 99   CONTINUE
      IF (IPCHE1.NE.IPCHEL) THEN
        mchelm = IPCHE1
        IF (mchelm.NE.0) SEGSUP,mchelm
      ENDIF
      IF (IPMOD1.NE.0) THEN
        mmode1 = IPMOD1
        SEGSUP,mmode1
      ENDIF
cc      IF (IPRIGI.EQ.0) SEGSUP,mrigid
 
c      return
      END