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    OF166741  25/02/21    21:16:51     12166          
  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 CCHAMP
  29.  
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMCOORD
  33. -INC SMMODEL
  34. -INC SMINTE
  35.  
  36. -INC TMPTVAL
  37.  
  38.       SEGMENT NOTYPE
  39.         CHARACTER*16 TYPE(NBTYPE)
  40.       ENDSEGMENT
  41.  
  42.       DIMENSION  CRIGI(12)
  43.       CHARACTER*8 CMATE
  44.       CHARACTER*(NCONCH) CONM
  45.       CHARACTER*16 MOMODL(10)
  46.       PARAMETER ( NINF=3 )
  47.       INTEGER INFOS(NINF)
  48.       LOGICAL lsupva,lsupma,lsupca
  49.  
  50.       lsupma=.false.
  51.       lsupca=.false.
  52.       lsupva=.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,IRETCA)
  59.       IF (ISUP5.GT.1) RETURN
  60. *
  61. *     VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  62. *
  63.       CALL  QUESUP(IPMODL,IPVARI,5,0,ISUP5,IRETVI)
  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.          MOVARI=0
  95.          IVARI=0
  96.          IPMINT=0
  97. C
  98. C     ON RECUPERE L INFORMATION GENERALE
  99. C
  100.          IMODEL=KMODEL(ISOUS)
  101.          SEGACT IMODEL
  102.          IPMAIL=IMAMOD
  103.          CONM  =CONMOD
  104. *
  105.          MELE=NEFMOD
  106.          MELEME=IMAMOD
  107.          SEGACT MELEME
  108.          NBNN=NUM(/1)
  109.          NBELEM=NUM(/2)
  110. C+PPf
  111. C     ON EVACUE LE CAS DU SEGS EN 3D
  112.          IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN
  113.             CALL ERREUR(832)
  114.             GOTO 9990
  115.          ENDIF
  116. C+PPf
  117. C
  118. C     TRAITEMENT DU MODELE
  119. C
  120.          NFOR=FORMOD(/2)
  121.          NMAT=MATMOD(/2)
  122. C
  123. C     NATURE DU MATERIAU
  124. C
  125.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  126.          IF (CMATE.EQ.' ')THEN
  127.             CALL ERREUR(251)
  128.             GOTO 9990
  129.          ENDIF
  130.          IF(MATE.NE.1)THEN
  131.             CALL ERREUR(635)
  132.             GOTO 9990
  133.          ENDIF
  134.          CALL TEMANF(INFIBR,NIFIBR)
  135.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  136.             CALL ERREUR(636)
  137.             GOTO 9990
  138.          ENDIF
  139.          INFIBR=NIFIBR
  140. *
  141. C____________________________________________________________________
  142. C
  143. C     INFORMATION SUR L'ELEMENT FINI
  144. C____________________________________________________________________
  145. C
  146.          MFR  =INFELE(13)
  147.          IPPORE=0
  148.          IF(MFR.EQ.33) IPPORE=NBNN
  149.          IF (MFR.NE.47)THEN
  150.             CALL ERREUR(637)
  151.             GOTO 9990
  152.          ENDIF
  153.          NBG  =INFELE(6)
  154.          NBGS =INFELE(4)
  155.          LRE  =INFELE(9)
  156. *        MINTE=INFELE(11)
  157.         MINTE=INFMOD(7)
  158.         IPMINT=MINTE
  159.         SEGACT,MINTE
  160. C
  161. C     CREATION DU TABLEAU INFOS
  162. C
  163.          CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
  164.          IF (IRTD.EQ.0) GOTO 9990
  165. *
  166. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  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. *       TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  251. *
  252.         if(lnomid(10).ne.0) then
  253.          nomid=lnomid(10)
  254.          segact nomid
  255.          movari=nomid
  256.          nvari=lesobl(/2)
  257.          nvarf=lesfac(/2)
  258.          lsupva=.false.
  259.         else
  260.          lsupva=.true.
  261.          CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  262.         endif
  263. *
  264.         NBTYPE=1
  265.         SEGINI NOTYPE
  266.         MOTYPE=NOTYPE
  267.         TYPE(1)='REAL*8'
  268. *
  269.         CALL KOMCHA(IPVARI,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  270.         SEGSUP NOTYPE
  271.         IF (IERR.NE.0) GOTO 9990
  272.         NVART=NVARI+NVARF
  273. *
  274. *     APPEL AU CALCUL PROPREMENT DIT
  275. *
  276.          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  277.            CALL FRI2T2(INFIBR,MELE,IPMAIL,IPMINT,NBGS,
  278.      1        IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVART,
  279.      2        CRIGI)
  280.          ELSE
  281.            CALL FRIGT2(INFIBR,MELE,IPMAIL,IPMINT,NBGS,
  282.      1        IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVART,
  283.      2        CRIGI)
  284.          ENDIF
  285. *
  286.  9990    CONTINUE
  287. *
  288. *     DESACTIVATION DES SEGMENTS
  289. *
  290.          SEGDES,MELEME,IMODEL
  291. *
  292.          IF (IPMINT.NE.0) SEGDES,MINTE
  293.          IF(ISUP5.EQ.1)THEN
  294.             CALL DTMVAL (IVAMAT,3)
  295.             CALL DTMVAL (IVACAR,3)
  296.          ELSE
  297.             CALL DTMVAL (IVAMAT,1)
  298.             CALL DTMVAL (IVACAR,1)
  299.          ENDIF
  300. *
  301.          IF (MOCARA.NE.0) THEN
  302.             NOMID=MOCARA
  303.             if(lsupca)SEGSUP NOMID
  304.          END IF
  305.          IF (MOVARI.NE.0) THEN
  306.             NOMID=MOVARI
  307.             if(lsupva)SEGSUP NOMID
  308.          END IF
  309. *
  310.          IF (MOMATR.NE.0) THEN
  311.             NOMID=MOMATR
  312.             if(lsupma)SEGSUP NOMID
  313.          END IF
  314. *
  315.          IF (IERR.NE.0) GO TO 888
  316. *
  317. 1000  CONTINUE
  318. *
  319.  888  CONTINUE
  320.       SEGDES MMODEL
  321.       RETURN
  322.       END
  323.  
  324.  
  325.  
  326.  

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