Télécharger la plaquette Cast3M


fr en

Télécharger famore.eso

Retour à la liste

Numérotation des lignes : 

famore

  1. C FAMORE    SOURCE    OF166741  25/02/21    21:16:22     12166          
  2.       SUBROUTINE FAMORE(IPMODL,IPCAR,CRIGI,CMASS)
  3. **********************************************************************
  4. *
  5. *     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  6. *     CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
  7. *     ... AU SIGNE PRES
  8. *     CONTRIBUTION DE CHAQUE ELEMENT DE CHAQUE SS_ZONE DU MODELE
  9. *     DE SECTION
  10. *
  11. **********************************************************************
  12. *
  13. *  ENTREES:
  14. *
  15. *  IPMODL = POINTEUR SUR UN OBJET MMODEL
  16. *  IPCAR  = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  17. *
  18. * SORTIES:
  19. *
  20. *  CRIGI(12) ELEMENT DE REDUCTION DE LA RIGIDITE
  21. *  CMASS(12) ELEMENT DE REDUCTION DE LA MASSE
  22. *
  23. ************************************************************************
  24. *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  25. ***********************************************************************
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8(A-H,O-Z)
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCHAMP
  32.  
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMMODEL
  37. -INC SMINTE
  38.  
  39. -INC TMPTVAL
  40.  
  41.       SEGMENT NOTYPE
  42.         CHARACTER*16 TYPE(NBTYPE)
  43.       ENDSEGMENT
  44.  
  45.       CHARACTER*8 CMATE
  46.       CHARACTER*(NCONCH) CONM
  47.       CHARACTER*16 MOMODL(10)
  48.       DIMENSION  CRIGI(12),CMASS(12)
  49.       PARAMETER ( NINF=3 )
  50.       INTEGER INFOS(NINF)
  51.       LOGICAL lsupma,lsupca
  52. C
  53.          lsupca=.false.
  54.       NHRM=NIFOUR
  55. C
  56. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  57. C
  58.       CALL  QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5)
  59.       IF (ISUP5.GT.1) RETURN
  60. C
  61. C     ACTIVATION DU MODELE
  62. C
  63.       MMODEL=IPMODL
  64.       SEGACT MMODEL
  65.       NSOUS=KMODEL(/1)
  66. C
  67. C     MISE A ZERO DES RIGIDITES
  68. C
  69.       DO IE1=1,12
  70.         CRIGI(IE1)=0.D0
  71.         CMASS(IE1)=0.D0
  72.       ENDDO
  73. C____________________________________________________________________
  74. C
  75. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  76. C____________________________________________________________________
  77. C
  78.       DO 1000 ISOUS=1,NSOUS
  79. *
  80. *   INITIALISATION
  81. *
  82.          MOMATR=0
  83.          IVAMAT=0
  84.          MOCARA=0
  85.          IVACAR=0
  86. C
  87. C     ON RECUPERE L INFORMATION GENERALE
  88. C
  89.          IMODEL=KMODEL(ISOUS)
  90.          SEGACT IMODEL
  91.          IPMAIL=IMAMOD
  92.          CONM  =CONMOD
  93. *
  94.          MELE=NEFMOD
  95.          MELEME=IMAMOD
  96.          SEGACT MELEME
  97.          NBNN=NUM(/1)
  98.          NBELEM=NUM(/2)
  99. C
  100. C     TRAITEMENT DU MODELE
  101. C
  102. C     NATURE DU MATERIAU
  103. C
  104.          CMATE  = CMATEE
  105.          MATE   = IMATEE
  106.          INFIBR = INATUU
  107.          IF(MATE.NE.1)THEN
  108.             CALL ERREUR(635)
  109.             GOTO 9993
  110.          ENDIF
  111.          CALL TEMANF(INFIBR,NIFIBR)
  112.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  113.             CALL ERREUR(636)
  114.             GOTO 9993
  115.          ENDIF
  116.  
  117. C____________________________________________________________________
  118. C
  119. C     INFORMATION SUR L'ELEMENT FINI
  120. C____________________________________________________________________
  121. C
  122. *         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  123. *         IF (IERR.NE.0) GOTO 9993
  124.          MFR  =INFELE(13)
  125.          IF (MFR.NE.47)THEN
  126.             CALL ERREUR(637)
  127.             GOTO 9993
  128.          ENDIF
  129.          NBG  =INFELE(6)
  130.          NBGS =INFELE(4)
  131.          LRE  =INFELE(9)
  132. *         MINTE=INFELE(11)
  133.          MINTE=INFMOD(7)
  134.          IPMINT=MINTE
  135.          SEGACT,MINTE
  136.          IPPORE=0
  137.          IF(MFR.EQ.33) IPPORE=NBNN
  138. C
  139. C     CREATION DU TABLEAU INFOS
  140. C
  141.          CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  142.          IF (IRTD.EQ.0) GOTO 9992
  143. *
  144. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  145.         if(lnomid(6).ne.0) then
  146.          nomid=lnomid(6)
  147.          segact nomid
  148.          momatr=nomid
  149.          nmatr=lesobl(/2)
  150.          nmatf=lesfac(/2)
  151.          lsupma=.false.
  152.         else
  153.          lsupma=.true.
  154.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  155.         endif
  156.         IF (MOMATR.EQ.0) THEN
  157.            MOTERR(1:4)='MATE'
  158.            MOTERR(5:8)=NOMTP(MELE)
  159.            CALL ERREUR (76)
  160.            GOTO 9990
  161.         ENDIF
  162. *
  163.         IF (NIFIBR.NE.8) THEN
  164.          NBTYPE=1
  165.          SEGINI NOTYPE
  166.          MOTYPE=NOTYPE
  167.          TYPE(1)='REAL*8'
  168. *
  169.         ELSE
  170.           NBTYPE=13
  171.           SEGINI NOTYPE
  172.           MOTYPE=NOTYPE
  173.           DO I=1,NBTYPE
  174.             TYPE(I)='REAL*8'
  175.           ENDDO
  176.           TYPE(10)='POINTEUREVOLUTIO'
  177.           TYPE(11)='POINTEUREVOLUTIO'
  178.         ENDIF
  179. *
  180.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  181.      &                                  INFOS,3,IVAMAT)
  182.         SEGSUP NOTYPE
  183. *
  184.         IF (IERR.NE.0) GOTO 9990
  185.         NMATT=NMATR+NMATF
  186. *
  187.         IF (ISUP5.EQ.1) THEN
  188.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  189.            IF (IERR.NE.0) THEN
  190.               ISUP5=0
  191.               GOTO 9990
  192.            ENDIF
  193.         ENDIF
  194. *
  195. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  196. *
  197.         if(lnomid(7).ne.0) then
  198.          nomid=lnomid(7)
  199.          segact nomid
  200.          mocara=nomid
  201.          ncara=lesobl(/2)
  202.          ncarf=lesfac(/2)
  203.          lsupca=.false.
  204.         else
  205.          lsupca=.true.
  206.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  207.         endif
  208. *
  209.         NBTYPE=1
  210.         SEGINI NOTYPE
  211.         MOTYPE=NOTYPE
  212.         TYPE(1)='REAL*8'
  213. *
  214.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  215.      &                                     INFOS,3,IVACAR)
  216.         SEGSUP NOTYPE
  217.         IF (IERR.NE.0) GOTO 9990
  218.         NCARR=NCARA+NCARF
  219. *
  220.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  221.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  222.            IF (IERR.NE.0) THEN
  223.               ISUP5=0
  224.               GOTO 9990
  225.            ENDIF
  226.         ENDIF
  227. *
  228. *     APPEL AU CALCUL PROPREMENT DIT
  229. *
  230.          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  231.            CALL FAMO22(MELE,IPMAIL,IPMINT,NBGS,
  232.      1        IVAMAT,IVACAR,NMATT,NCARR,
  233.      2        CRIGI,CMASS)
  234.          ELSE
  235.            CALL FAMOR2(MELE,IPMAIL,IPMINT,NBGS,
  236.      3        IVAMAT,IVACAR,NMATT,NCARR,
  237.      4        CRIGI,CMASS)
  238.          ENDIF
  239. *
  240.  9990    CONTINUE
  241. *
  242. *     DESACTIVATION DES SEGMENTS
  243. *
  244.          IF(ISUP5.EQ.1)THEN
  245.             CALL DTMVAL (IVAMAT,3)
  246.             CALL DTMVAL (IVACAR,3)
  247.          ELSE
  248.             CALL DTMVAL (IVAMAT,1)
  249.             CALL DTMVAL (IVACAR,1)
  250.          ENDIF
  251. *
  252.          IF (MOCARA.NE.0) THEN
  253.             NOMID=MOCARA
  254.             if(lsupca)SEGSUP NOMID
  255.          END IF
  256. *
  257.          IF (MOMATR.NE.0) THEN
  258.             NOMID=MOMATR
  259.             if(lsupma)SEGSUP NOMID
  260.          END IF
  261. *
  262.  9992    CONTINUE
  263.          SEGDES,MINTE
  264.  9993    CONTINUE
  265.          SEGDES MELEME,IMODEL
  266. *
  267.          IF (IERR.NE.0) GOTO 888
  268. *
  269. 1000  CONTINUE
  270. *
  271.  888  CONTINUE
  272.       SEGDES,MMODEL
  273.  
  274.       RETURN
  275.       END
  276.  
  277.  
  278.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales