Télécharger la plaquette Cast3M


fr en

Télécharger gyro3.eso

Retour à la liste

Numérotation des lignes : 

gyro3

  1. C GYRO3     SOURCE    CB215821  24/04/12    21:16:13     11897          
  2.           SUBROUTINE GYRO3(IPMAIL,LRE,LW,MELE,IVAMAT,NMATT,IVACAR,
  3.      &NCARR,IVECT,ISOUS,NBPGAU,IPMINT,IPMIN2,NDDL,MATE,CMATE,
  4.      &LHOOK,IPMATR,IIPDPG)
  5. *---------------------------------------------------------------------*
  6. *        _________________________________________________            *
  7. *        |                                                |           *
  8. *        |  calcul de la matrice de couplage gyroscopique |           *
  9. *        |  Matrice classique dans le repere inertiel     |           *
  10. *        |________________________________________________|           *
  11. *                                                                     *
  12. *      poutre,timo,tuyau                                              *
  13. *                                                                     *
  14. *---------------------------------------------------------------------*
  15. *                                                                     *
  16. *   entrees :                                                         *
  17. *   ________                                                          *
  18. *                                                                     *
  19. *        ipmail   pointeur sur un segment  meleme                     *
  20. *        lre      nombre de ddl dans la matrice de masse              *
  21. *        lw       dimension du tableau de travail de l'element        *
  22. *        mele     numero de l'element fini                            *
  23. *        ivamat   pointeur sur un segment mptval pour le materiau     *
  24. *        nmatt    nombre de composante de materiau (imat=1)           *
  25. *        ivacar   pointeur sur un segment mptval pour les caracteri-  *
  26. *                 stiques                                             *
  27. *        ncarr    nombre de caracteristiques geometriques             *
  28. *        ivect    flag indiquant si on a entree les axes locaux       *
  29. *        isous     numero de la sous-zone                             *
  30. *        nbpgau   nombre de point d'integration pour la masse         *
  31. *        ipmint   pointeur sur un segment minte                       *
  32. *        ipmin1   pointeur sur un segment minte (aux noeuds)          *
  33. *        nddl     nombre de degre de liberte /noeud                   *
  34. *        mate     numero du materiau                                  *
  35. *       cmate     nom du materiau                                     *
  36. *       vrot      vecteur vitesse de rotation                         *
  37. *                                                                     *
  38. *   sorties :                                                         *
  39. *   ________                                                          *
  40. *                                                                     *
  41. *        ipmatr   pointeur sur la matrice d'amortissement             *
  42. *                 de la sous-zone                                     *
  43. *                                                                     *
  44. *                Didier COMBESCURE mars 2003                          *
  45. *                                                                     *
  46. *---------------------------------------------------------------------*
  47.       IMPLICIT INTEGER(I-N)
  48.       IMPLICIT REAL*8(A-H,O-Z)
  49.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. -INC CCHAMP
  53. -INC CCREEL
  54. *-
  55. -INC SMRIGID
  56. -INC SMCHAML
  57. -INC SMELEME
  58. -INC SMCOORD
  59. -INC SMINTE
  60. -INC SMMODEL
  61. C
  62.       SEGMENT WRK1
  63.       REAL*8 REL(LRE,LRE),XE(3,NBBB)
  64.       ENDSEGMENT
  65. C
  66.       SEGMENT WRK2
  67.       REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  68.       ENDSEGMENT
  69. C
  70.       SEGMENT WRK3
  71.       REAL*8 DDHOOK(LHOOK,LHOOK)
  72.       REAL*8 WORK(LW)
  73.       ENDSEGMENT
  74. C
  75.       SEGMENT WRK4
  76.       REAL*8 BPSS(3,3),XEL(3,NBBB)
  77.       ENDSEGMENT
  78. C
  79.       SEGMENT WRK6
  80.       REAL*8 RHOMAT(6,6)
  81.       ENDSEGMENT
  82. C
  83.       SEGMENT MVELCH
  84.       REAL*8 VALMAT(NV1)
  85.       ENDSEGMENT
  86. C
  87.       SEGMENT MPTVAL
  88.       INTEGER IPOS(NS),NSOF(NS)
  89.       INTEGER IVAL(NCOSOU)
  90.       CHARACTER*16 TYVAL(NCOSOU)
  91.       ENDSEGMENT
  92. *
  93.       DIMENSION CRIGI(12),CMASS(12)
  94.       CHARACTER*8 CMATE
  95. *
  96.       MELEME=IPMAIL
  97.       NBNN=NUM(/1)
  98.       NBELEM=NUM(/2)
  99. *
  100.       NV1=NMATT
  101.       SEGINI,MVELCH
  102. *
  103.       xMATRI=IPMATR
  104.       LVAL  = (LRE*(LRE+1))/2
  105.       NLIGRP=LRE
  106.       NLIGRD=LRE
  107. *
  108.       NHRM=NIFOUR
  109. *
  110.       MINTE=IPMINT
  111.       MINTE2=IPMIN2
  112. C_______________________________________________________________________
  113. C
  114. C     NUMERO DES ETIQUETTES      :
  115. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  116. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  117. C     5  CONTINUE
  118. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  119. C     44 CONTINUE
  120. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  121. C_______________________________________________________________________
  122. C
  123.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  124.      199,99,99,99,99,99,27,99,27,99,99,99,99,99,99,99,99,99,99,99,
  125.      299,27,99,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  126.      399,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  127.      499,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99),MELE
  128.       GOTO 99
  129. C_______________________________________________________________________
  130. C_______________________________________________________________________
  131. C
  132. C     ELEMENTS POUTRES
  133. C_______________________________________________________________________
  134. C
  135.   27  CONTINUE
  136. C
  137. C  CAS DES POUTRES - TUYAUX
  138. C
  139.       NBBB=NBNN
  140.       SEGINI WRK1,WRK3
  141. *
  142. *  cas du materiau section
  143. *
  144.       NBGMAT = 0
  145.       NELMAT = 0
  146.       IF(CMATE.EQ.'SECTION') THEN
  147.           MPTVAL=IVAMAT
  148.           DO IM=1,NMATT
  149.           IF(IVAL(IM).NE.0)THEN
  150.               MELVAL=IVAL(IM)
  151.               NBGMAT=MAX(NBGMAT,IELCHE(/1))
  152.               NELMAT=MAX(NELMAT,IELCHE(/2))
  153.           END IF
  154.           END DO
  155.       ENDIF
  156. C
  157. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  158. C
  159.       SEGACT,MCOORD
  160.       DO 3027 IB=1,NBELEM
  161. C
  162. C     ON CHERCHE LES COORDONNEES DE L ELEMENT IB
  163. C
  164.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  165. C
  166. C
  167. C        CAS DES POUTRES
  168. C        --------------
  169. C  ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES ET MATERIELLES DANS WORK
  170. C
  171.  5029     CONTINUE
  172. C
  173. C  ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB ( GEOMETRIE ET MASSE
  174. C
  175. C
  176.           NCARR1=NCARR
  177.           CALL ZERO(WORK,NCARR1,1)
  178.           DO 4029 IGAU=1,NBNN
  179.               MPTVAL=IVACAR
  180.               DO 6029 IC=1,NCARR1
  181.                   MELVAL=IVAL(IC)
  182.                   IF (IVAL(IC).NE.0) THEN
  183.                       IBMN=MIN(IB,VELCHE(/2))
  184.                       IGMN=MIN(IGAU,VELCHE(/1))
  185.                       WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN)
  186.                   ELSE
  187.                       WORK(IC)=0.D0
  188.                   ENDIF
  189.                   IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN
  190.  6029         CONTINUE
  191.  4029     CONTINUE
  192. C
  193. C
  194.           MPTVAL=IVAMAT
  195. C
  196. C CAS DES POUTRES ET TUYAU
  197. C
  198.               MELVAL=IVAL(1)
  199.               IF(CMATE.NE.'SECTION') THEN
  200.                   IBMN=MIN(IB,VELCHE(/2))
  201. C
  202.                   WORK(11)=VELCHE(1,IBMN)
  203. C
  204. C  CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE
  205. C  --------------   EQUIVALENTE
  206. C
  207.                   IF(MELE.EQ.42) CALL TUYCAG(WORK,KERRE,1)
  208.               ELSE
  209. *
  210. *       cas formulation section
  211. *
  212.                   IBMN=MIN(IB,IELCHE(/2))
  213.                   IPMODL=IELCHE(1,IBMN)
  214.                   MELVAL=IVAL(2)
  215.                   IBMN=MIN(IB,IELCHE(/2))
  216.                   IPMAT=IELCHE(1,IBMN)
  217.                   IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)THEN
  218.                       CALL FRIGIE(IPMODL,IPMAT,CRIGI,CMASS)
  219.                       CALL DOGTIF(CMASS,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  220.                   ENDIF
  221.               ENDIF
  222. C
  223. C  ON CALCULE LA MATRICE DE COUPLAGE GYROSCOPIQUE
  224. C
  225.          IF (MELE.EQ.84) THEN
  226.               IF(CMATE.NE.'SECTION') THEN
  227.                 CALL TIMGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  228.               ELSE
  229.                 CALL TIFGYR(REL,LRE,WORK,XE,WORK(12),LHOOK,
  230.      &          DDHOOK,KERRE)
  231.               ENDIF
  232.           ELSE
  233.                  CALL POUGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  234.           ENDIF
  235. C
  236.           IF(KERRE.EQ.0) GO TO 4027
  237.           INTERR(1)=ISOUS
  238.           INTERR(2)=IB
  239.           SEGSUP WRK1,WRK3,MVELCH
  240.           CALL ERREUR(128)
  241.           SEGSUP xMATRI
  242.           GO TO 510
  243. C
  244.  4027     CONTINUE
  245. *          SEGINI XMATRI
  246. *          IMATTT(IB)=XMATRI
  247.           DO      IIIA=1,LRE
  248.            DO      IIIB=1,LRE
  249.            RE(IIIA,IIIB,ib)=REL(IIIA,IIIB)
  250.            enddo   
  251.           enddo   
  252. C
  253.  3027 CONTINUE
  254.       SEGSUP WRK1,WRK3,MVELCH
  255.       GO TO 510
  256. C_______________________________________________________________________
  257. *
  258.    99 CONTINUE
  259.       MOTERR(1:4)=NOMTP(MELE)
  260.       MOTERR(5:12)='GYRO2'
  261.       CALL ERREUR(86)
  262. *
  263.   510 CONTINUE
  264.       RETURN
  265.       END
  266. C
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  

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