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    OF166741  25/02/21    21:16:53     12166          
  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. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31.  
  32. -INC SMCHAML
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMMODEL
  36. -INC SMINTE
  37.  
  38. -INC TMPTVAL
  39.  
  40.       DIMENSION CRIGI(12)
  41. *
  42.       SEGMENT NOTYPE
  43.         CHARACTER*16 TYPE(NBTYPE)
  44.       ENDSEGMENT
  45. *
  46.       CHARACTER*8 CMATE
  47.       CHARACTER*(NCONCH) CONM
  48.       CHARACTER*16 MOMODL(10)
  49.       PARAMETER ( NINF=3 )
  50.       INTEGER INFOS(NINF)
  51.       LOGICAL lsupma,lsupca
  52.  
  53.       lsupma=.false.
  54.       lsupca=.false.
  55. C
  56.       NHRM=NIFOUR
  57. C
  58. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  59. C
  60.       CALL QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRETMA)
  61.       IF (ISUP5.GT.1) RETURN
  62. C
  63. C     ACTIVATION DU MODELE
  64. C
  65.       MMODEL=IPMODL
  66.       SEGACT MMODEL
  67.       NSOUS=KMODEL(/1)
  68. C
  69. C     MISE A ZERO DES RIGIDITES
  70. C
  71.       DO IE1=1,12
  72.         CRIGI(IE1)=0.D0
  73.       ENDDO
  74. C____________________________________________________________________
  75. C
  76. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  77. C____________________________________________________________________
  78. C
  79.       DO 1000 ISOUS=1,NSOUS
  80. *
  81. *   INITIALISATION
  82. *
  83.          NMATF=0
  84.          NMATR=0
  85.          MOMATR=0
  86.          IVAMAT=0
  87.          NCARA=0
  88.          NCARF=0
  89.          MOCARA=0
  90.          IVACAR=0
  91.          IPMINT=0
  92. C
  93. C     ON RECUPERE L INFORMATION GENERALE
  94. C
  95.          IMODEL=KMODEL(ISOUS)
  96.          SEGACT IMODEL
  97.          IPMAIL=IMAMOD
  98.          CONM  =CONMOD
  99. *
  100.          MELE=NEFMOD
  101.          MELEME=IMAMOD
  102.          SEGACT MELEME
  103.          NBNN=NUM(/1)
  104.          NBELEM=NUM(/2)
  105. C
  106. C     TRAITEMENT DU MODELE
  107. C
  108.          NFOR=FORMOD(/2)
  109.          NMAT=MATMOD(/2)
  110. C
  111. C     NATURE DU MATERIAU
  112. C
  113.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  114.          IF (CMATE.EQ.' ')THEN
  115.             CALL ERREUR(251)
  116.             GOTO 9990
  117.          ENDIF
  118.          IF(MATE.NE.1)THEN
  119.             CALL ERREUR(635)
  120.             GOTO 9990
  121.          ENDIF
  122.          CALL TEMANF(INFIBR,NIFIBR)
  123.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  124.             CALL ERREUR(636)
  125.             GOTO 9990
  126.          ENDIF
  127. C____________________________________________________________________
  128. C
  129. C     INFORMATION SUR L'ELEMENT FINI
  130. C____________________________________________________________________
  131. C
  132. *         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  133. *         IF (IERR.NE.0) GOTO 9990
  134. *         INFO=IPINF
  135.          MFR  =INFELE(13)
  136.          IPPORE=0
  137.          IF(MFR.EQ.33) IPPORE=NBNN
  138.  
  139.          IF (MFR.NE.47)THEN
  140.             CALL ERREUR(637)
  141.             GOTO 9990
  142.          ENDIF
  143. *
  144.          NBG  =INFELE(6)
  145.          NBGS =INFELE(4)
  146.          LRE  =INFELE(9)
  147. *         MINTE=INFELE(11)
  148.          MINTE=INFMOD(7)
  149.          IPMINT=MINTE
  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 9990
  155. *
  156. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  157. *
  158.         if(lnomid(6).ne.0) then
  159.          nomid=lnomid(6)
  160.          segact nomid
  161.          momatr=nomid
  162.          nmatr=lesobl(/2)
  163.          nmatf=lesfac(/2)
  164.          lsupma=.false.
  165.         else
  166.          lsupma=.true.
  167.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  168.         endif
  169.         IF (MOMATR.EQ.0) THEN
  170.            MOTERR(1:4)='MATE'
  171.            MOTERR(5:8)=NOMTP(MELE)
  172.            CALL ERREUR (76)
  173.            GOTO 9990
  174.         ENDIF
  175. *
  176.            NBTYPE=1
  177.            SEGINI NOTYPE
  178.            MOTYPE=NOTYPE
  179.            TYPE(1)='REAL*8'
  180. *
  181.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  182.      &                                  INFOS,3,IVAMAT)
  183.         SEGSUP NOTYPE
  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.          CALL FRITH2(MELE,IPMAIL,IPMINT,NBGS,IVAMAT,IVACAR,
  231.      &    NMATT,NCARR,CRIGI,IELA,ICONT)
  232. *
  233.  9990    CONTINUE
  234. *
  235. *     DESACTIVATION DES SEGMENTS
  236. *
  237.          SEGDES MELEME,IMODEL
  238.          IF (IPMINT.NE.0) SEGDES,MINTE
  239. *
  240.          IF(ISUP5.EQ.1)THEN
  241.             CALL DTMVAL (IVAMAT,3)
  242.             CALL DTMVAL (IVACAR,3)
  243.          ELSE
  244.             CALL DTMVAL (IVAMAT,1)
  245.             CALL DTMVAL (IVACAR,1)
  246.          ENDIF
  247. *
  248.          IF (MOCARA.NE.0) THEN
  249.             NOMID=MOCARA
  250.             if(lsupca)SEGSUP NOMID
  251.          END IF
  252. *
  253.          IF (MOMATR.NE.0) THEN
  254.             NOMID=MOMATR
  255.             if(lsupma)SEGSUP NOMID
  256.          END IF
  257. *
  258.          IF (IERR.NE.0) GOTO 888
  259. *
  260. 1000  CONTINUE
  261. *
  262.  888  CONTINUE
  263.       SEGDES MMODEL
  264.  
  265.       RETURN
  266.       END
  267.  
  268.  
  269.  

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