Télécharger la plaquette Cast3M


fr en

Télécharger frigie.eso

Retour à la liste

Numérotation des lignes : 

frigie

  1. C FRIGIE    SOURCE    OF166741  25/02/21    21:16:49     12166          
  2.       SUBROUTINE FRIGIE(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.          lsupca=.false.
  53. C
  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.          NMATF=0
  83.          NMATR=0
  84.          MOMATR=0
  85.          IVAMAT=0
  86.          NCARA=0
  87.          NCARF=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. C
  101. C     TRAITEMENT DU MODELE
  102. C
  103.          NFOR=FORMOD(/2)
  104.          NMAT=MATMOD(/2)
  105. C
  106. C     NATURE DU MATERIAU
  107. C
  108.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  109.          IF (CMATE.EQ.' ')THEN
  110.             CALL ERREUR(251)
  111.             RETURN
  112.          ENDIF
  113.          IF(MATE.NE.1)THEN
  114.             CALL ERREUR(635)
  115.             RETURN
  116.          ENDIF
  117.          CALL TEMANF(INFIBR,NIFIBR)
  118.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  119.             CALL ERREUR(636)
  120.             RETURN
  121.          ENDIF
  122. *
  123.          SEGACT MELEME
  124.          NBNN=NUM(/1)
  125.          NBELEM=NUM(/2)
  126. C____________________________________________________________________
  127. C
  128. C     INFORMATION SUR L'ELEMENT FINI
  129. C____________________________________________________________________
  130. C
  131. *         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  132. *         IF (IERR.NE.0) THEN
  133. *            RETURN
  134. *         ENDIF
  135. *         INFO=IPINF
  136.          MFR  =INFELE(13)
  137.          IF (MFR.NE.47)THEN
  138.             CALL ERREUR(637)
  139.             RETURN
  140.          ENDIF
  141.          NBG  =INFELE(6)
  142.          NBGS =INFELE(4)
  143.          LRE  =INFELE(9)
  144. *         MINTE=INFELE(11)
  145.          minte=infmod(7)
  146.          IPPORE=0
  147.          IF(MFR.EQ.33) IPPORE=NBNN
  148. C
  149. C     CREATION DU TABLEAU INFOS
  150. C
  151.          CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  152.          IF (IRTD.EQ.0)THEN
  153. *            INFO=IPINF
  154. *            SEGSUP INFO
  155.             RETURN
  156.          ENDIF
  157.          IPMINT=MINTE
  158.          SEGACT,MINTE
  159. *
  160. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  161. *
  162.         if(lnomid(6).ne.0) then
  163.          nomid=lnomid(6)
  164.          segact nomid
  165.          momatr=nomid
  166.          nmatr=lesobl(/2)
  167.          nmatf=lesfac(/2)
  168.          lsupma=.false.
  169.         else
  170.          lsupma=.true.
  171.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  172.         endif
  173.         IF (MOMATR.EQ.0) THEN
  174.            MOTERR(1:4)='MATE'
  175.            MOTERR(5:8)=NOMTP(MELE)
  176.            CALL ERREUR (76)
  177.            GOTO 9990
  178.         ENDIF
  179. *
  180.         IF (NIFIBR.NE.8) THEN
  181.          NBTYPE=1
  182.          SEGINI NOTYPE
  183.          MOTYPE=NOTYPE
  184.          TYPE(1)='REAL*8'
  185. *
  186.         ELSE
  187.           NBTYPE=13
  188.           SEGINI NOTYPE
  189.           MOTYPE=NOTYPE
  190.           DO I=1,NBTYPE
  191.             TYPE(I)='REAL*8'
  192.           ENDDO
  193.           TYPE(10)='POINTEUREVOLUTIO'
  194.           TYPE(11)='POINTEUREVOLUTIO'
  195. *
  196.         ENDIF
  197. *
  198.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  199.      &                                  INFOS,3,IVAMAT)
  200.         SEGSUP NOTYPE
  201.         IF (IERR.NE.0) GOTO 9990
  202.         NMATT=NMATR+NMATF
  203. *
  204.         IF (ISUP5.EQ.1) THEN
  205.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  206.            IF (IERR.NE.0) THEN
  207.               ISUP5=0
  208.               GOTO 9990
  209.            ENDIF
  210.         ENDIF
  211. *
  212. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  213. *
  214.         if(lnomid(7).ne.0) then
  215.          nomid=lnomid(7)
  216.          segact nomid
  217.          mocara=nomid
  218.          ncara=lesobl(/2)
  219.          ncarf=lesfac(/2)
  220.          lsupca=.false.
  221.         else
  222.          lsupca=.true.
  223.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  224.         endif
  225. *
  226.         NBTYPE=1
  227.         SEGINI NOTYPE
  228.         MOTYPE=NOTYPE
  229.         TYPE(1)='REAL*8'
  230. *
  231.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  232.      &                                     INFOS,3,IVACAR)
  233.         SEGSUP NOTYPE
  234.         IF (IERR.NE.0) GOTO 9990
  235.         NCARR=NCARA+NCARF
  236. *
  237.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  238.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  239.            IF (IERR.NE.0) THEN
  240.               ISUP5=0
  241.               GOTO 9990
  242.            ENDIF
  243.         ENDIF
  244. *
  245. *     APPEL AU CALCUL PROPREMENT DIT
  246. *
  247.          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  248.            CALL FRIG22(MELE,IPMAIL,MINTE,NBGS,
  249.      1        IVAMAT,IVACAR,NMATT,NCARR,
  250.      2        CRIGI,CMASS)
  251.          ELSE
  252.            CALL FRIGI2(MELE,IPMAIL,MINTE,NBGS,
  253.      3        IVAMAT,IVACAR,NMATT,NCARR,
  254.      4        CRIGI,CMASS)
  255.          ENDIF
  256. *
  257.  9990    CONTINUE
  258. *
  259. *     DESACTIVATION DES SEGMENTS
  260. *
  261. *
  262.          IF(ISUP5.EQ.1)THEN
  263.             CALL DTMVAL (IVAMAT,3)
  264.             CALL DTMVAL (IVACAR,3)
  265.          ELSE
  266.             CALL DTMVAL (IVAMAT,1)
  267.             CALL DTMVAL (IVACAR,1)
  268.          ENDIF
  269. *
  270.          IF (MOCARA.NE.0) THEN
  271.             NOMID=MOCARA
  272.             if(lsupca)SEGSUP NOMID
  273.          END IF
  274. *
  275.          IF (MOMATR.NE.0) THEN
  276.             NOMID=MOMATR
  277.             if(lsupma)SEGSUP NOMID
  278.          END IF
  279. *
  280. *         IF (IPINF .NE.0) THEN
  281. *             INFO=IPINF
  282. *             SEGSUP INFO
  283. *         END IF
  284. *
  285.          IF (IERR.NE.0) GO TO 888
  286. *
  287. 1000  CONTINUE
  288. *
  289.  888  CONTINUE
  290. *
  291.       END
  292.  
  293.  
  294.  

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