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    JK148537  26/08/27    21:15:07     12628          
  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.         nbrobl = 2
  181.         nmatr = nbrobl
  182.         nbrfac = 1
  183.         nmatf = nbrfac
  184.         segini nomid
  185.         momatr = nomid
  186.         lesobl(1)='YOUN'
  187.         lesobl(2)='NU'
  188.         lesfac(1)='RHO'
  189. *
  190.         IF (NIFIBR.NE.8) THEN
  191.          NBTYPE=1
  192.          SEGINI NOTYPE
  193.          MOTYPE=NOTYPE
  194.          TYPE(1)='REAL*8'
  195. *
  196.         ELSE
  197.           NBTYPE=13
  198.           SEGINI NOTYPE
  199.           MOTYPE=NOTYPE
  200.           DO I=1,NBTYPE
  201.             TYPE(I)='REAL*8'
  202.           ENDDO
  203.           TYPE(10)='POINTEUREVOLUTIO'
  204.           TYPE(11)='POINTEUREVOLUTIO'
  205. *
  206.         ENDIF
  207. *
  208.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  209.      &                                  INFOS,3,IVAMAT)
  210.         SEGSUP NOTYPE
  211.         IF (IERR.NE.0) GOTO 9990
  212.         NMATT=NMATR+NMATF
  213. c        nomid = momatr
  214. c        write(6,*) 'lesobl',(lesobl(jj),jj=1,nmatr)
  215. c        write(6,*) 'lesfac',(lesfac(jj),jj=1,nmatf)
  216. *
  217.         IF (ISUP5.EQ.1) THEN
  218.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  219.            IF (IERR.NE.0) THEN
  220.               ISUP5=0
  221.               GOTO 9990
  222.            ENDIF
  223.         ENDIF
  224. *
  225. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  226. *
  227.         if(lnomid(7).ne.0) then
  228.          nomid=lnomid(7)
  229.          segact nomid
  230.          mocara=nomid
  231.          ncara=lesobl(/2)
  232.          ncarf=lesfac(/2)
  233.          lsupca=.false.
  234.         else
  235.          lsupca=.true.
  236.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  237.         endif
  238. *
  239.         NBTYPE=1
  240.         SEGINI NOTYPE
  241.         MOTYPE=NOTYPE
  242.         TYPE(1)='REAL*8'
  243. *
  244.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  245.      &                                     INFOS,3,IVACAR)
  246.         SEGSUP NOTYPE
  247.         IF (IERR.NE.0) GOTO 9990
  248.         NCARR=NCARA+NCARF
  249. *
  250.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  251.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  252.            IF (IERR.NE.0) THEN
  253.               ISUP5=0
  254.               GOTO 9990
  255.            ENDIF
  256.         ENDIF
  257. *
  258. *     APPEL AU CALCUL PROPREMENT DIT
  259. *
  260.          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  261.            CALL FRIG22(MELE,IPMAIL,MINTE,NBGS,
  262.      1        IVAMAT,IVACAR,NMATT,NCARR,
  263.      2        CRIGI,CMASS)
  264.          ELSE
  265.            CALL FRIGI2(MELE,IPMAIL,MINTE,NBGS,
  266.      3        IVAMAT,IVACAR,NMATT,NCARR,
  267.      4        CRIGI,CMASS)
  268.          ENDIF
  269. *
  270.  9990    CONTINUE
  271. *
  272. *     DESACTIVATION DES SEGMENTS
  273. *
  274. *
  275.          IF(ISUP5.EQ.1)THEN
  276.             CALL DTMVAL (IVAMAT,3)
  277.             CALL DTMVAL (IVACAR,3)
  278.          ELSE
  279.             CALL DTMVAL (IVAMAT,1)
  280.             CALL DTMVAL (IVACAR,1)
  281.          ENDIF
  282. *
  283.          IF (MOCARA.NE.0) THEN
  284.             NOMID=MOCARA
  285.             if(lsupca)SEGSUP NOMID
  286.          END IF
  287. *
  288.          IF (MOMATR.NE.0) THEN
  289.             NOMID=MOMATR
  290.             if(lsupma)SEGSUP NOMID
  291.          END IF
  292. *
  293. *         IF (IPINF .NE.0) THEN
  294. *             INFO=IPINF
  295. *             SEGSUP INFO
  296. *         END IF
  297. *
  298.          IF (IERR.NE.0) GO TO 888
  299. *
  300. 1000  CONTINUE
  301. *
  302.  888  CONTINUE
  303. *
  304.       END
  305.  
  306.  
  307.  
  308.  

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