Télécharger la plaquette Cast3M


fr en

Télécharger frigth.eso

Retour à la liste

Numérotation des lignes : 

frigth

  1. C FRIGTH    SOURCE    CB215821  24/04/12    21:16:06     11897          
  2.       SUBROUTINE FRIGTH(IPMODL,IPCAR,CRIGI,IELA,ICONT)
  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. *
  22. ************************************************************************
  23. *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  24. ***********************************************************************
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8(A-H,O-Z)
  27. *
  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)
  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.          lsupma=.false.
  57.          lsupca=.false.
  58. C
  59.       NHRM=NIFOUR
  60. C
  61. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  62. C
  63.       CALL QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRETMA)
  64.       IF (ISUP5.GT.1) RETURN
  65. C
  66. C     ACTIVATION DU MODELE
  67. C
  68.       MMODEL=IPMODL
  69.       SEGACT MMODEL
  70.       NSOUS=KMODEL(/1)
  71. C
  72. C     MISE A ZERO DES RIGIDITES
  73. C
  74.       DO IE1=1,12
  75.         CRIGI(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.          NMATF=0
  87.          NMATR=0
  88.          MOMATR=0
  89.          IVAMAT=0
  90.          NCARA=0
  91.          NCARF=0
  92.          MOCARA=0
  93.          IVACAR=0
  94.          IPMINT=0
  95. C
  96. C     ON RECUPERE L INFORMATION GENERALE
  97. C
  98.          IMODEL=KMODEL(ISOUS)
  99.          SEGACT IMODEL
  100.          IPMAIL=IMAMOD
  101.          CONM  =CONMOD
  102. *
  103.          MELE=NEFMOD
  104.          MELEME=IMAMOD
  105.          SEGACT MELEME
  106.          NBNN=NUM(/1)
  107.          NBELEM=NUM(/2)
  108. C
  109. C     TRAITEMENT DU MODELE
  110. C
  111.          NFOR=FORMOD(/2)
  112.          NMAT=MATMOD(/2)
  113. C
  114. C     NATURE DU MATERIAU
  115. C
  116.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  117.          IF (CMATE.EQ.' ')THEN
  118.             CALL ERREUR(251)
  119.             GOTO 9990
  120.          ENDIF
  121.          IF(MATE.NE.1)THEN
  122.             CALL ERREUR(635)
  123.             GOTO 9990
  124.          ENDIF
  125.          CALL TEMANF(INFIBR,NIFIBR)
  126.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  127.             CALL ERREUR(636)
  128.             GOTO 9990
  129.          ENDIF
  130. C____________________________________________________________________
  131. C
  132. C     INFORMATION SUR L'ELEMENT FINI
  133. C____________________________________________________________________
  134. C
  135. *         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  136. *         IF (IERR.NE.0) GOTO 9990
  137. *         INFO=IPINF
  138.          MFR  =INFELE(13)
  139.          IPPORE=0
  140.          IF(MFR.EQ.33) IPPORE=NBNN
  141.  
  142.          IF (MFR.NE.47)THEN
  143.             CALL ERREUR(637)
  144.             GOTO 9990
  145.          ENDIF
  146. *
  147.          NBG  =INFELE(6)
  148.          NBGS =INFELE(4)
  149.          LRE  =INFELE(9)
  150. *         MINTE=INFELE(11)
  151.          MINTE=INFMOD(7)
  152.          IPMINT=MINTE
  153. C
  154. C     CREATION DU TABLEAU INFOS
  155. C
  156.          CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  157.          IF (IRTD.EQ.0) GOTO 9990
  158. *
  159. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  160. *
  161.         if(lnomid(6).ne.0) then
  162.          nomid=lnomid(6)
  163.          segact nomid
  164.          momatr=nomid
  165.          nmatr=lesobl(/2)
  166.          nmatf=lesfac(/2)
  167.          lsupma=.false.
  168.         else
  169.          lsupma=.true.
  170.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  171.         endif
  172.         IF (MOMATR.EQ.0) THEN
  173.            MOTERR(1:4)='MATE'
  174.            MOTERR(5:8)=NOMTP(MELE)
  175.            CALL ERREUR (76)
  176.            GOTO 9990
  177.         ENDIF
  178. *
  179.            NBTYPE=1
  180.            SEGINI NOTYPE
  181.            MOTYPE=NOTYPE
  182.            TYPE(1)='REAL*8'
  183. *
  184.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  185.      &                                  INFOS,3,IVAMAT)
  186.         SEGSUP NOTYPE
  187.         IF (IERR.NE.0) GOTO 9990
  188.         NMATT=NMATR+NMATF
  189. *
  190.         IF (ISUP5.EQ.1) THEN
  191.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  192.            IF(IERR.NE.0)THEN
  193.               ISUP5=0
  194.               GOTO 9990
  195.            ENDIF
  196.         ENDIF
  197. *
  198. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  199. *
  200.         if(lnomid(7).ne.0) then
  201.          nomid=lnomid(7)
  202.          segact nomid
  203.          mocara=nomid
  204.          ncara=lesobl(/2)
  205.          ncarf=lesfac(/2)
  206.          lsupca=.false.
  207.         else
  208.          lsupca=.true.
  209.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  210.         endif
  211. *
  212.         NBTYPE=1
  213.         SEGINI NOTYPE
  214.         MOTYPE=NOTYPE
  215.         TYPE(1)='REAL*8'
  216. *
  217.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  218.      &                                     INFOS,3,IVACAR)
  219.         SEGSUP NOTYPE
  220.         IF (IERR.NE.0) GOTO 9990
  221.         NCARR=NCARA+NCARF
  222. *
  223.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  224.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  225.            IF(IERR.NE.0)THEN
  226.               ISUP5=0
  227.               GOTO 9990
  228.            ENDIF
  229.         ENDIF
  230. *
  231. *     APPEL AU CALCUL PROPREMENT DIT
  232. *
  233.          CALL FRITH2(MELE,IPMAIL,IPMINT,NBGS,IVAMAT,IVACAR,
  234.      &    NMATT,NCARR,CRIGI,IELA,ICONT)
  235. *
  236.  9990    CONTINUE
  237. *
  238. *     DESACTIVATION DES SEGMENTS
  239. *
  240.          SEGDES MELEME,IMODEL
  241.          IF (IPMINT.NE.0) SEGDES,MINTE
  242. *
  243.          IF(ISUP5.EQ.1)THEN
  244.             CALL DTMVAL (IVAMAT,3)
  245.             CALL DTMVAL (IVACAR,3)
  246.          ELSE
  247.             CALL DTMVAL (IVAMAT,1)
  248.             CALL DTMVAL (IVACAR,1)
  249.          ENDIF
  250. *
  251.          IF (MOCARA.NE.0) THEN
  252.             NOMID=MOCARA
  253.             if(lsupca)SEGSUP NOMID
  254.          END IF
  255. *
  256.          IF (MOMATR.NE.0) THEN
  257.             NOMID=MOMATR
  258.             if(lsupma)SEGSUP NOMID
  259.          END IF
  260. *
  261.          IF (IERR.NE.0) GOTO 888
  262. *
  263. 1000  CONTINUE
  264. *
  265.  888  CONTINUE
  266.       SEGDES MMODEL
  267. *
  268.       RETURN
  269.       END
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  

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