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    OF166741  25/02/21    21:17:21     12166          
  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.  
  62. -INC TMPTVAL
  63.  
  64.       SEGMENT WRK1
  65.       REAL*8 REL(LRE,LRE),XE(3,NBBB)
  66.       ENDSEGMENT
  67. C
  68.       SEGMENT WRK2
  69.       REAL*8 SHPWRK(6,NBNO),BGENE(NDDL,LRE)
  70.       ENDSEGMENT
  71. C
  72.       SEGMENT WRK3
  73.       REAL*8 DDHOOK(LHOOK,LHOOK)
  74.       REAL*8 WORK(LW)
  75.       ENDSEGMENT
  76. C
  77.       SEGMENT WRK4
  78.       REAL*8 BPSS(3,3),XEL(3,NBBB)
  79.       ENDSEGMENT
  80. C
  81.       SEGMENT WRK6
  82.       REAL*8 RHOMAT(6,6)
  83.       ENDSEGMENT
  84. C
  85.       SEGMENT MVELCH
  86.       REAL*8 VALMAT(NV1)
  87.       ENDSEGMENT
  88.  
  89.       DIMENSION CRIGI(12),CMASS(12)
  90.       CHARACTER*8 CMATE
  91. *
  92.       MELEME=IPMAIL
  93.       NBNN=NUM(/1)
  94.       NBELEM=NUM(/2)
  95. *
  96.       NV1=NMATT
  97.       SEGINI,MVELCH
  98. *
  99.       xMATRI=IPMATR
  100.       LVAL  = (LRE*(LRE+1))/2
  101.       NLIGRP=LRE
  102.       NLIGRD=LRE
  103. *
  104.       NHRM=NIFOUR
  105. *
  106.       MINTE=IPMINT
  107.       MINTE2=IPMIN2
  108. C_______________________________________________________________________
  109. C
  110. C     NUMERO DES ETIQUETTES      :
  111. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  112. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  113. C     5  CONTINUE
  114. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  115. C     44 CONTINUE
  116. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  117. C_______________________________________________________________________
  118. C
  119.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  120.      199,99,99,99,99,99,27,99,27,99,99,99,99,99,99,99,99,99,99,99,
  121.      299,27,99,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  122.      399,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  123.      499,99,99,27,99,99,99,99,99,99,99,99,99,99,99,99,99),MELE
  124.       GOTO 99
  125. C_______________________________________________________________________
  126. C_______________________________________________________________________
  127. C
  128. C     ELEMENTS POUTRES
  129. C_______________________________________________________________________
  130. C
  131.   27  CONTINUE
  132. C
  133. C  CAS DES POUTRES - TUYAUX
  134. C
  135.       NBBB=NBNN
  136.       SEGINI WRK1,WRK3
  137. *
  138. *  cas du materiau section
  139. *
  140.       NBGMAT = 0
  141.       NELMAT = 0
  142.       IF(CMATE.EQ.'SECTION') THEN
  143.           MPTVAL=IVAMAT
  144.           DO IM=1,NMATT
  145.             MELVAL=IVAL(IM)
  146.             IF(MELVAL.NE.0)THEN
  147.               NBGMAT=MAX(NBGMAT,IELCHE(/1))
  148.               NELMAT=MAX(NELMAT,IELCHE(/2))
  149.             END IF
  150.           END DO
  151.       ENDIF
  152. C
  153. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  154. C
  155.       SEGACT,MCOORD
  156.       DO 3027 IB=1,NBELEM
  157. C
  158. C     ON CHERCHE LES COORDONNEES DE L ELEMENT IB
  159. C
  160.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  161. C
  162. C        CAS DES POUTRES
  163. C        --------------
  164. C  ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES ET MATERIELLES DANS WORK
  165. C
  166.  5029     CONTINUE
  167. C
  168. C  ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB ( GEOMETRIE ET MASSE
  169. C
  170. C
  171.           NCARR1=NCARR
  172.           CALL ZERO(WORK,NCARR1,1)
  173.           DO 4029 IGAU=1,NBNN
  174.               MPTVAL=IVACAR
  175.               DO 6029 IC=1,NCARR1
  176.                   MELVAL=IVAL(IC)
  177.                   IF (MELVAL.NE.0) THEN
  178.                       IBMN=MIN(IB,VELCHE(/2))
  179.                       IGMN=MIN(IGAU,VELCHE(/1))
  180.                       WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN)
  181.                   ELSE
  182.                       WORK(IC)=0.D0
  183.                   ENDIF
  184.                   IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN
  185.  6029         CONTINUE
  186.  4029     CONTINUE
  187. C
  188. C
  189. C CAS DES POUTRES ET TUYAU
  190. C
  191.           MPTVAL=IVAMAT
  192.               MELVAL=IVAL(1)
  193.               IF(CMATE.NE.'SECTION') THEN
  194.                   IBMN=MIN(IB,VELCHE(/2))
  195. C
  196.                   WORK(11)=VELCHE(1,IBMN)
  197. C
  198. C  CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE
  199. C  --------------   EQUIVALENTE
  200. C
  201.                   IF(MELE.EQ.42) CALL TUYCAG(WORK,KERRE,1)
  202.               ELSE
  203. *
  204. *       cas formulation section
  205. *
  206.                   IBMN=MIN(IB,IELCHE(/2))
  207.                   IPMODL=IELCHE(1,IBMN)
  208.                   MELVAL=IVAL(2)
  209.                   IBMN=MIN(IB,IELCHE(/2))
  210.                   IPMAT=IELCHE(1,IBMN)
  211.                   IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)THEN
  212.                       CALL FRIGIE(IPMODL,IPMAT,CRIGI,CMASS)
  213.                       CALL DOGTIF(CMASS,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  214.                   ENDIF
  215.               ENDIF
  216. C
  217. C  ON CALCULE LA MATRICE DE COUPLAGE GYROSCOPIQUE
  218. C
  219.          IF (MELE.EQ.84) THEN
  220.               IF(CMATE.NE.'SECTION') THEN
  221.                 CALL TIMGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  222.               ELSE
  223.                 CALL TIFGYR(REL,LRE,WORK,XE,WORK(12),LHOOK,
  224.      &          DDHOOK,KERRE)
  225.               ENDIF
  226.           ELSE
  227.                  CALL POUGYR(REL,LRE,WORK,XE,WORK(12),KERRE)
  228.           ENDIF
  229. C
  230.           IF(KERRE.EQ.0) GO TO 4027
  231.           INTERR(1)=ISOUS
  232.           INTERR(2)=IB
  233.           SEGSUP WRK1,WRK3,MVELCH
  234.           CALL ERREUR(128)
  235.           SEGSUP xMATRI
  236.           GO TO 510
  237. C
  238.  4027     CONTINUE
  239. *          SEGINI XMATRI
  240. *          IMATTT(IB)=XMATRI
  241.           DO      IIIA=1,LRE
  242.            DO      IIIB=1,LRE
  243.            RE(IIIA,IIIB,ib)=REL(IIIA,IIIB)
  244.            enddo
  245.           enddo
  246. C
  247.  3027 CONTINUE
  248.       SEGSUP WRK1,WRK3,MVELCH
  249.       GO TO 510
  250. C_______________________________________________________________________
  251. *
  252.    99 CONTINUE
  253.       MOTERR(1:4)=NOMTP(MELE)
  254.       MOTERR(5:12)='GYRO2'
  255.       CALL ERREUR(86)
  256. *
  257.   510 CONTINUE
  258.       RETURN
  259.       END
  260.  
  261.  
  262.  

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