Télécharger la plaquette Cast3M


fr en

Télécharger frigta.eso

Retour à la liste

Numérotation des lignes : 

frigta

  1. C FRIGTA    SOURCE    CB215821  24/04/12    21:16:06     11897          
  2.       SUBROUTINE FRIGTA(IPMODL,IPCAR,IPVARI,CRIGI)
  3. **********************************************************************
  4. *
  5. *     COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE
  6. *     CONTRIBUTION DES ELEMENTS DE CHAQUE SS_ZONE DU MODELE DE
  7. *     SECTION
  8. *
  9. **********************************************************************
  10. *
  11. *  ENTREES:
  12. *
  13. *  IPMODL = POINTEUR SUR UN OBJET MMODEL
  14. *  IPCAR  = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  15. *  IPVARI = POINTEUR SUR UN MCHAML DE VARIABLE INTERNE
  16. *
  17. * SORTIES:
  18. *
  19. *
  20. ************************************************************************
  21. *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  22. ***********************************************************************
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25. *
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMCOORD
  31. -INC SMMODEL
  32. -INC SMINTE
  33. -INC CCHAMP
  34. C
  35.       DIMENSION  CRIGI(12)
  36. *
  37.       SEGMENT NOTYPE
  38.         CHARACTER*16 TYPE(NBTYPE)
  39.       ENDSEGMENT
  40. *
  41.       SEGMENT MPTVAL
  42.         INTEGER IPOS(NS)    ,NSOF(NS)
  43.         INTEGER      IVAL(NCOSOU)
  44.         CHARACTER*16 TYVAL(NCOSOU)
  45.       ENDSEGMENT
  46. *
  47.       CHARACTER*8 CMATE
  48.       CHARACTER*(NCONCH) CONM
  49.       CHARACTER*16 MOMODL(10)
  50.       PARAMETER ( NINF=3 )
  51.       INTEGER INFOS(NINF)
  52.       LOGICAL lsupva,lsupma,lsupca
  53.          lsupma=.false.
  54.          lsupca=.false.
  55.          lsupva=.false.
  56. C
  57.       NHRM=NIFOUR
  58. C
  59. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  60. C
  61.       CALL  QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRETCA)
  62.       IF (ISUP5.GT.1) RETURN
  63. *
  64. *     VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  65. *
  66.       CALL  QUESUP(IPMODL,IPVARI,5,0,ISUP5,IRETVI)
  67.       IF (ISUP5.GT.1) RETURN
  68. C
  69. C     ACTIVATION DU MODELE
  70. C
  71.       MMODEL=IPMODL
  72.       SEGACT MMODEL
  73.       NSOUS=KMODEL(/1)
  74. C
  75. C     MISE A ZERO DES RIGIDITES
  76. C
  77.       DO IE1=1,12
  78.         CRIGI(IE1)=0.D0
  79.       ENDDO
  80. C____________________________________________________________________
  81. C
  82. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  83. C____________________________________________________________________
  84. C
  85.       DO 1000 ISOUS=1,NSOUS
  86. *
  87. *   INITIALISATION
  88. *
  89.          NMATF=0
  90.          NMATR=0
  91.          MOMATR=0
  92.          IVAMAT=0
  93.          NCARA=0
  94.          NCARF=0
  95.          MOCARA=0
  96.          IVACAR=0
  97.          MOVARI=0
  98.          IVARI=0
  99.          IPMINT=0
  100. C
  101. C     ON RECUPERE L INFORMATION GENERALE
  102. C
  103.          IMODEL=KMODEL(ISOUS)
  104.          SEGACT IMODEL
  105.          IPMAIL=IMAMOD
  106.          CONM  =CONMOD
  107. *
  108.          MELE=NEFMOD
  109.          MELEME=IMAMOD
  110.          SEGACT MELEME
  111.          NBNN=NUM(/1)
  112.          NBELEM=NUM(/2)
  113. C+PPf
  114. C     ON EVACUE LE CAS DU SEGS EN 3D
  115.          IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN
  116.             CALL ERREUR(832)
  117.             GOTO 9990
  118.          ENDIF
  119. C+PPf
  120. C
  121. C     TRAITEMENT DU MODELE
  122. C
  123.          NFOR=FORMOD(/2)
  124.          NMAT=MATMOD(/2)
  125. C
  126. C     NATURE DU MATERIAU
  127. C
  128.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  129.          IF (CMATE.EQ.' ')THEN
  130.             CALL ERREUR(251)
  131.             GOTO 9990
  132.          ENDIF
  133.          IF(MATE.NE.1)THEN
  134.             CALL ERREUR(635)
  135.             GOTO 9990
  136.          ENDIF
  137.          CALL TEMANF(INFIBR,NIFIBR)
  138.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  139.             CALL ERREUR(636)
  140.             GOTO 9990
  141.          ENDIF
  142.          INFIBR=NIFIBR
  143. *
  144. C____________________________________________________________________
  145. C
  146. C     INFORMATION SUR L'ELEMENT FINI
  147. C____________________________________________________________________
  148. C
  149.          MFR  =INFELE(13)
  150.          IPPORE=0
  151.          IF(MFR.EQ.33) IPPORE=NBNN
  152.          IF (MFR.NE.47)THEN
  153.             CALL ERREUR(637)
  154.             GOTO 9990
  155.          ENDIF
  156.          NBG  =INFELE(6)
  157.          NBGS =INFELE(4)
  158.          LRE  =INFELE(9)
  159. *        MINTE=INFELE(11)
  160.         MINTE=INFMOD(7)
  161.         IPMINT=MINTE
  162.         SEGACT,MINTE
  163. C
  164. C     CREATION DU TABLEAU INFOS
  165. C
  166.          CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  167.          IF (IRTD.EQ.0) GOTO 9990
  168. *
  169. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  170.         if(lnomid(6).ne.0) then
  171.          nomid=lnomid(6)
  172.          segact nomid
  173.          momatr=nomid
  174.          nmatr=lesobl(/2)
  175.          nmatf=lesfac(/2)
  176.          lsupma=.false.
  177.         else
  178.          lsupma=.true.
  179.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  180.         endif
  181.         IF (MOMATR.EQ.0) THEN
  182.            MOTERR(1:4)='MATE'
  183.            MOTERR(5:8)=NOMTP(MELE)
  184.            CALL ERREUR (76)
  185.            GOTO 9990
  186.         ENDIF
  187. *
  188.         IF (NIFIBR.NE.8) THEN
  189.            NBTYPE=1
  190.            SEGINI NOTYPE
  191.            MOTYPE=NOTYPE
  192.            TYPE(1)='REAL*8'
  193. *
  194.         ELSE
  195.           NBTYPE=13
  196.           SEGINI NOTYPE
  197.           MOTYPE=NOTYPE
  198.           DO I=1,NBTYPE
  199.             TYPE(I)='REAL*8'
  200.           ENDDO
  201.           TYPE(10)='POINTEUREVOLUTIO'
  202.           TYPE(11)='POINTEUREVOLUTIO'
  203. *
  204.         ENDIF
  205. *
  206.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  207.      &                                  INFOS,3,IVAMAT)
  208.         SEGSUP NOTYPE
  209.         IF (IERR.NE.0) GOTO 9990
  210.         NMATT=NMATR+NMATF
  211. *
  212.         IF (ISUP5.EQ.1) THEN
  213.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  214.            IF(IERR.NE.0)THEN
  215.               ISUP5=0
  216.               GOTO 9990
  217.            ENDIF
  218.         ENDIF
  219. *
  220. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  221. *
  222.         if(lnomid(7).ne.0) then
  223.          nomid=lnomid(7)
  224.          segact nomid
  225.          mocara=nomid
  226.          ncara=lesobl(/2)
  227.          ncarf=lesfac(/2)
  228.          lsupca=.false.
  229.         else
  230.          lsupca=.true.
  231.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  232.         endif
  233. *
  234.         NBTYPE=1
  235.         SEGINI NOTYPE
  236.         MOTYPE=NOTYPE
  237.         TYPE(1)='REAL*8'
  238. *
  239.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  240.      &                                     INFOS,3,IVACAR)
  241.         SEGSUP NOTYPE
  242.         IF (IERR.NE.0) GOTO 9990
  243.         NCARR=NCARA+NCARF
  244. *
  245.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  246.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  247.            IF(IERR.NE.0)THEN
  248.               ISUP5=0
  249.               GOTO 9990
  250.            ENDIF
  251.         ENDIF
  252. *
  253. *       TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  254. *
  255.         if(lnomid(10).ne.0) then
  256.          nomid=lnomid(10)
  257.          segact nomid
  258.          movari=nomid
  259.          nvari=lesobl(/2)
  260.          nvarf=lesfac(/2)
  261.          lsupva=.false.
  262.         else
  263.          lsupva=.true.
  264.          CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  265.         endif
  266. *
  267.         NBTYPE=1
  268.         SEGINI NOTYPE
  269.         MOTYPE=NOTYPE
  270.         TYPE(1)='REAL*8'
  271. *
  272.         CALL KOMCHA(IPVARI,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  273.         SEGSUP NOTYPE
  274.         IF (IERR.NE.0) GOTO 9990
  275.         NVART=NVARI+NVARF
  276. *
  277. *     APPEL AU CALCUL PROPREMENT DIT
  278. *
  279.          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  280.            CALL FRI2T2(INFIBR,MELE,IPMAIL,IPMINT,NBGS,
  281.      1        IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVART,
  282.      2        CRIGI)
  283.          ELSE
  284.            CALL FRIGT2(INFIBR,MELE,IPMAIL,IPMINT,NBGS,
  285.      1        IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVART,
  286.      2        CRIGI)
  287.          ENDIF
  288. *
  289.  9990    CONTINUE
  290. *
  291. *     DESACTIVATION DES SEGMENTS
  292. *
  293.          SEGDES,MELEME,IMODEL
  294. *
  295.          IF (IPMINT.NE.0) SEGDES,MINTE
  296.          IF(ISUP5.EQ.1)THEN
  297.             CALL DTMVAL (IVAMAT,3)
  298.             CALL DTMVAL (IVACAR,3)
  299.          ELSE
  300.             CALL DTMVAL (IVAMAT,1)
  301.             CALL DTMVAL (IVACAR,1)
  302.          ENDIF
  303. *
  304.          IF (MOCARA.NE.0) THEN
  305.             NOMID=MOCARA
  306.             if(lsupca)SEGSUP NOMID
  307.          END IF
  308.          IF (MOVARI.NE.0) THEN
  309.             NOMID=MOVARI
  310.             if(lsupva)SEGSUP NOMID
  311.          END IF
  312. *
  313.          IF (MOMATR.NE.0) THEN
  314.             NOMID=MOMATR
  315.             if(lsupma)SEGSUP NOMID
  316.          END IF
  317. *
  318.          IF (IERR.NE.0) GO TO 888
  319. *
  320. 1000  CONTINUE
  321. *
  322.  888  CONTINUE
  323.       SEGDES MMODEL
  324.       RETURN
  325.       END
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  

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