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

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