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

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