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

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