Télécharger la plaquette Cast3M


fr en

Télécharger corio3.eso

Retour à la liste

Numérotation des lignes : 

corio3

  1. C CORIO3    SOURCE    OF166741  25/02/21    21:15:44     12166          
  2.       SUBROUTINE CORIO3(IPMAIL,NDDL,LRE,NBPGAU,IPMINT,
  3.      &MELE,MFR,IVAMAT,IVACAR,NMATT,IPMATR,VROT,NUMLIS,IIPDPG)
  4. *---------------------------------------------------------------------*
  5. *        __________________________________________________           *
  6. *        |                                                |           *
  7. *        |  calcul de la matrice de couplage gyroscopique |           *
  8. *        |________________________________________________|           *
  9. *                                                                     *
  10. *        massif                                                       *
  11. *                                                                     *
  12. *---------------------------------------------------------------------*
  13. *                                                                     *
  14. *   entrees :                                                         *
  15. *   ________                                                          *
  16. *                                                                     *
  17. *        ipmail   pointeur sur un segment  meleme                     *
  18. *        nddl     nombre de degre de liberte /noeud                   *
  19. *        lre      nombre de ddl dans la matrice de masse              *
  20. *        nbpgau   nombre de point d'integration pour la masse         *
  21. *        ipmint   pointeur sur un segment minte                       *
  22. *        ipmin1   pointeur sur un segment minte (aux noeuds)          *
  23. *        mele     numero de l'element fini                            *
  24. *        mfr      numero de la formulation                            *                                    *
  25. *        ivamat   pointeur sur un segment mptval pour le materiau ou  *
  26. *                 pour une matrice de hooke                           *
  27. *        ivacar   pointeur sur un segment mptval pour les             *
  28. *                 caracteristiques                                    *
  29. *        nmatt    nombre de composante de materiau (imat=1)           *
  30. *        vrot     vecteur vitesse de rotation                         *
  31. *                                                                     *
  32. *   sorties :                                                         *
  33. *   ________                                                          *
  34. *                                                                     *
  35. *        ipmatr   pointeur sur la matrice de couplage gyroscopique    *
  36. *                 de la sous-zone                                     *
  37. *                                                                     *
  38. *                    Didier COMBESCURE mars 2003                      *
  39. *---------------------------------------------------------------------*
  40.       IMPLICIT INTEGER(I-N)
  41.       IMPLICIT REAL*8(A-H,O-Z)
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC CCHAMP
  46. -INC CCREEL
  47.  
  48. -INC SMRIGID
  49. -INC SMCHAML
  50. -INC SMELEME
  51. -INC SMCOORD
  52. -INC SMINTE
  53. -INC SMMODEL
  54.  
  55. -INC TMPTVAL
  56.  
  57.       SEGMENT WRK1
  58.       REAL*8 REL(LRE,LRE),XE(3,NBBB)
  59.       ENDSEGMENT
  60. c
  61.       SEGMENT WRK2
  62.       REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  63.       ENDSEGMENT
  64. c
  65.       SEGMENT WRK5
  66.       REAL*8 BLX(NDDL,LRE),BLY(NDDL,LRE),BLZ(NDDL,LRE)
  67.       REAL*8 BLT(NDDL,LRE)
  68.       ENDSEGMENT
  69. c
  70.       SEGMENT MVELCH
  71.       REAL*8 VALMAT(NV1)
  72.       ENDSEGMENT
  73.  
  74.       DIMENSION VROT(*)
  75. *
  76.       MELEME=IPMAIL
  77. c*      SEGACT,MELEME
  78.       NBNN=NUM(/1)
  79.       NBELEM=NUM(/2)
  80. *
  81.       NV1=NMATT
  82.       SEGINI,MVELCH
  83. *
  84.       xMATRI=IPMATR
  85. c*      SEGACT,xMATRI
  86. C*      NLIGRP=LRE
  87. C*      NLIGRD=LRE
  88.  
  89.       XDPGE=0.D0
  90.       YDPGE=0.D0
  91. *
  92.       NHRM=NIFOUR
  93. *
  94.       MINTE=IPMINT
  95. c*      SEGACT,MINTE
  96.  
  97. c_______________________________________________________________________
  98. c
  99. c     numero des etiquettes      :
  100. c     etiquettes de 1 a 98 pour traitement specifique a l element
  101. c     dans la zone specifique a chaque element commencant par :
  102. c     5  continue
  103. c     element 5   etiquettes 1005 2005 3005 4005   ...
  104. c     44 continue
  105. c     element 44  etiquettes 1044 2044 3044 4044   ...
  106. c_______________________________________________________________________
  107. c
  108. *                 CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  109.             GOTO (  99,  99,  99,  21,  99,  21,  99,  21,  99,  21,  99
  110. *                 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  111.      &           ,  99,  99,  11,  11,  11,  11,  99,  99,  99,  99,  99
  112. *                 TET4 TE10 PYR5 PY13 COQ3  DKT POUT LISP FAC3 FAC4 FAC6
  113.      &           ,  11,  11,  11,  11,  99,  99,  99,  99,  99,  99,  99
  114. *                 FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  115.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  116. *                 POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  117.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  118. *                 COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  119.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  120. *                 THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  121.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  122. *                 IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  123.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  124. *                 JOI6 JOI8 LISC TRIH  DST LIC4 CERC TUYO LSE2 LITU HYT3
  125.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  126. *                 HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  127.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  128. *                 POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  129.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  130. *                 PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  131.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  132. *                 PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  133.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  134. *                 TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  135.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  136. *                 TE56 PY91 TRH6
  137.      &           ,  99,  99,  99),MELE
  138.       GOTO 99
  139. c_______________________________________________________________________
  140. c
  141. c     secteur de calcul pour les elements massifs
  142. c_______________________________________________________________________
  143. c
  144.   11  CONTINUE
  145.       DIM3=1.D0
  146.       NBNO=NBNN
  147.       NBBB=NBNN
  148.       SEGINI WRK1,WRK2
  149.       DO 1005  IB=1,NBELEM
  150. c
  151. c        on cherche  les coordonnees des noeuds de l element ib
  152. c
  153.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  154.           CALL ZERO (REL,LRE,LRE)
  155. c
  156. c        boucle sur les points de gauss
  157. c
  158.           ISDJC=0
  159.           DO 1004  IGAU=1,NBPGAU
  160. *
  161.               CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  162.      1                    DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  163.               IF(DJAC.LT.0.) ISDJC=ISDJC+1
  164.               IF (DJAC.EQ.0.) THEN
  165.                 INTERR(1)= IB
  166.                 CALL ERREUR(259)
  167.                 GOTO 9011
  168.               ENDIF
  169.               DJAC=ABS(DJAC)*POIGAU(IGAU)
  170.               MPTVAL=IVAMAT
  171.               IF (IVAL(1).NE.0) THEN
  172.                   MELVAL=IVAL(1)
  173.                   IGMN=MIN(IGAU,VELCHE(/1))
  174.                   IBMN=MIN(IB,VELCHE(/2))
  175.                   VALMAT(1)=VELCHE(IGMN,IBMN)
  176.               ELSE
  177.                   VALMAT(1)=0.D0
  178.               ENDIF
  179.               DJAC=DJAC*VALMAT(1)
  180.               CALL NTNST(BGENE,DJAC,LRE,NDDL,REL)
  181. C
  182.  1004     CONTINUE
  183. C
  184. C+DC On bouscule la matrice de masse
  185. C
  186.           IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  187.              INTERR(1)=IB
  188.              CALL ERREUR(195)
  189.              GOTO 9011
  190.           ENDIF
  191. c
  192. c        remplissage de xmatri
  193. c
  194.            CALL MTOGYR(LRE,NDDL,REL,VROT,RE(1,1,ib))
  195. C
  196.  1005 CONTINUE
  197.  
  198.  9011 CONTINUE
  199.       SEGSUP WRK1,WRK2
  200.       GOTO 510
  201. C
  202. c_______________________________________________________________________
  203. c
  204. c     secteur de calcul pour les elements 2D en mode de Fourier
  205. c_______________________________________________________________________
  206. c
  207.   21  CONTINUE
  208.       DIM3=1.D0
  209.       NBNO=NBNN
  210.       NBBB=NBNN
  211.       SEGINI WRK1,WRK2
  212.       DO 2005  IB=1,NBELEM
  213. c
  214. c        on cherche  les coordonnees des noeuds de l element ib
  215. c
  216.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  217.           CALL ZERO (REL,LRE,LRE)
  218. c
  219. c        boucle sur les points de gauss
  220. c
  221.           ISDJC=0
  222.           DO 2004  IGAU=1,NBPGAU
  223. *
  224.               CALL NMATST(IGAU,MELE,MFR,NBNN,LRE/2,IFOUR,NIFOUR,NDDL/2,
  225.      1        DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  226.               IF(DJAC.LT.0.) ISDJC=ISDJC+1
  227.               IF(DJAC.EQ.0.) THEN
  228.                 INTERR(1)= IB
  229.                 CALL ERREUR(259)
  230.                 GOTO 9021
  231.               ENDIF
  232.               DJAC=ABS(DJAC)*POIGAU(IGAU)
  233.               MPTVAL=IVAMAT
  234.               IF (IVAL(1).NE.0) THEN
  235.                   MELVAL=IVAL(1)
  236.                   IGMN=MIN(IGAU,VELCHE(/1))
  237.                   IBMN=MIN(IB,VELCHE(/2))
  238.                   VALMAT(1)=VELCHE(IGMN,IBMN)
  239.               ELSE
  240.                   VALMAT(1)=0.D0
  241.               ENDIF
  242.               DJAC=DJAC*VALMAT(1)
  243.               CALL NTNST(BGENE,DJAC,LRE/2,NDDL/2,REL)
  244. C
  245.  2004     CONTINUE
  246. C
  247.           IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  248.              INTERR(1)=IB
  249.              CALL ERREUR(195)
  250.              GOTO 9021
  251.           ENDIF
  252. c
  253. c        remplissage de xmatri
  254. c
  255.           IF (NUMLIS.EQ.1) THEN
  256.             CALL MTOGY2(LRE/2,NDDL/2,REL,VROT,RE(1,1,ib))
  257.           ELSE
  258.             CALL MTOGYF(LRE/2,NDDL/2,REL,VROT,RE(1,1,ib))
  259.           ENDIF
  260. C
  261.  2005 CONTINUE
  262.  
  263.  9021 CONTINUE
  264.       SEGSUP WRK1,WRK2
  265.       GOTO 510
  266. c_______________________________________________________________________
  267. *
  268.    99 CONTINUE
  269.       MOTERR(1:4)=NOMTP(MELE)
  270.       MOTERR(5:12)='CORIO3'
  271.       CALL ERREUR(86)
  272. *
  273.   510 CONTINUE
  274.       SEGSUP,MVELCH
  275.  
  276.       RETURN
  277.       END
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  

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