Télécharger la plaquette Cast3M


fr en

Télécharger dyne13.eso

Retour à la liste

Numérotation des lignes : 

dyne13

  1. C DYNE13    SOURCE    CB215821  24/04/12    21:15:38     11897          
  2.       SUBROUTINE DYNE13(ITBAS,ITKM,KPREF,KCPR,LMODYN)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     V{rification des objets TBAS, TKM, et notamment de             *
  11. *     leurs supports. Liste des points de r{f{rence.                 *
  12. *                                                                    *
  13. *     Param}tres:                                                    *
  14. *                                                                    *
  15. * e   ITBAS   Table repr{sentant une base modale                     *
  16. * e   ITKM    Table contenant les matrices de raideur et de masse    *
  17. *  s  KPREF   Segment des points de r{f{rence                        *
  18. *  s  KCPR    Segment des points                                     *
  19. *                                                                    *
  20. *     Auteur, date de cr{ation:                                      *
  21. *                                                                    *
  22. *     Denis ROBERT-MOUGIN, le 30 mai 1989.                           *
  23. *                                                                    *
  24. *--------------------------------------------------------------------*
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMRIGID
  29. -INC SMCHPOI
  30. -INC SMELEME
  31. -INC SMCOORD
  32. -INC SMMODEL
  33. *
  34.       SEGMENT,ICPR(nbpts)
  35.       SEGMENT,MPREF
  36.          INTEGER IPOREF(NPREF)
  37.       ENDSEGMENT
  38. *
  39.       LOGICAL L0,L1,LMODYN
  40.       CHARACTER*4  MO2
  41.       CHARACTER*8  TYPRET,CHARRE
  42.       CHARACTER*40 MONMOT
  43. *
  44.       IK    = 0
  45.       IRIG  = 0
  46.       IMAS  = 0
  47.       IMESS = 0
  48.       SEGINI,ICPR
  49.       KCPR = ICPR
  50.       LCPR = nbpts
  51. *
  52. *    1/ Cas oº la base modale est d{finie seule
  53. *
  54.       IF (ITBAS.NE.0 .AND.ITKM.EQ.0.and.(.not.lmodyn)) THEN
  55.          CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0,
  56.      &                     'MOT',I1,X1,MONMOT,L1,IP1)
  57.          IF (IERR.NE.0) RETURN
  58. *
  59. *        Cas oº la base est unique
  60. *
  61.          IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
  62. *
  63. *           On r{cup}re la base de modes
  64. *
  65.             CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'MODES',L0,IP0,
  66.      &                        'TABLE',I1,X1,' ',L1,IBAS)
  67.             IF (IERR.NE.0) RETURN
  68.             CALL DYNE25(IBAS,KCPR,IK)
  69.             IF (IERR.NE.0) RETURN
  70. *
  71. *        Cas oº on a un ensemble de bases
  72. *
  73.          ELSE IF (MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
  74. *
  75. *           On boucle sur le nombre de bases
  76. *
  77.             IB = 0
  78.  10         CONTINUE
  79.             IB = IB + 1
  80.             TYPRET = ' '
  81.             CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
  82.      &                          TYPRET,I1,X1,CHARRE,L1,ITTBAS)
  83.             IF (IERR.NE.0) RETURN
  84.             IF (ITTBAS.NE.0) THEN
  85.                IF (TYPRET.EQ.'TABLE   ') THEN
  86.                   CALL ACCTAB(ITTBAS,'MOT',I0,X0,'MODES',L0,IP0,
  87.      &                             'TABLE',I1,X1,' ',L1,IBAS)
  88.                   IF (IERR.NE.0) RETURN
  89.                   CALL DYNE25(IBAS,KCPR,IK)
  90.                   IF (IERR.NE.0) RETURN
  91.                   GOTO 10
  92.                ELSE
  93.                   CALL ERREUR(491)
  94.                   RETURN
  95.                ENDIF
  96.             ENDIF
  97. *
  98. *        Cas oº le SOUSTYPE est incorrect
  99. *
  100.          ELSE
  101.             CALL ERREUR(482)
  102.             RETURN
  103.          ENDIF
  104. *
  105. *     2/ Cas oº les matrices raideur et de masse sont d{finies seules
  106. *
  107.       ELSE IF (ITBAS.EQ.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN
  108.          TYPRET = ' '
  109.          CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
  110.      &                   TYPRET,I1,X1,CHARRE,L1,IRIG)
  111.          IF (IERR.NE.0) RETURN
  112.          IF (IRIG.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  113.             MRIGID = IRIG
  114.             SEGACT,MRIGID
  115.             NRIG = IRIGEL(/2)
  116.             DO 20 I=1,NRIG
  117.                MELEME = IRIGEL(1,I)
  118.                SEGACT,MELEME
  119.                NBEL = NUM(/2)
  120.                NBNN = NUM(/1)
  121.                DO 25 J=1,NBEL
  122.                   DO 26 K=1,NBNN
  123.                      KNOE = NUM(K,J)
  124.                      IF (ICPR(KNOE).EQ.0) THEN
  125.                         IK = IK + 1
  126.                         ICPR(KNOE) = IK
  127.       IF (IIMPI.EQ.333) THEN
  128.       WRITE(IOIMP,*)'DYNE13 : raideur ICPR(',KNOE,')=',ICPR(KNOE)
  129.       ENDIF
  130.                      ENDIF
  131.  26                  CONTINUE
  132. *                 end do
  133.  25               CONTINUE
  134. *              end do
  135.                SEGDES,MELEME
  136.  20            CONTINUE
  137. *           end do
  138.             SEGDES,MRIGID
  139. *
  140. *        Cas oº le SOUSTYPE est incorrect
  141. *
  142.          ELSE
  143.             CALL ERREUR(483)
  144.             RETURN
  145.          ENDIF
  146. *
  147.          TYPRET = ' '
  148.          CALL ACCTAB(ITKM,'MOT',I0,X0,'MASSE',L0,IP0,
  149.      &                   TYPRET,I1,X1,CHARRE,L1,IMAS)
  150.          IF (IERR.NE.0) RETURN
  151.          IF (IMAS.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
  152.             MRIGID = IMAS
  153.             SEGACT,MRIGID
  154.             NMAS = IRIGEL(/2)
  155.             DO 30 I=1,NMAS
  156.                MELEME = IRIGEL(1,I)
  157.                SEGACT,MELEME
  158.                NBEL = NUM(/2)
  159.                NBNN = NUM(/1)
  160.                DO 35 J=1,NBEL
  161.                   DO 36 K=1,NBNN
  162.                      KNOE = NUM(K,J)
  163.                      IF (ICPR(KNOE).EQ.0) THEN
  164.                         IK = IK + 1
  165.                         ICPR(KNOE) = IK
  166.       IF (IIMPI.EQ.333) THEN
  167.       WRITE(IOIMP,*)'DYNE13 : masse ICPR(',KNOE,')=',ICPR(KNOE)
  168.       ENDIF
  169.                      ENDIF
  170.  36                  CONTINUE
  171. *                 end do
  172.  35               CONTINUE
  173. *              end do
  174.                SEGDES,MELEME
  175.  30            CONTINUE
  176. *           end do
  177.             SEGDES,MRIGID
  178. *
  179. *        Cas oº le SOUSTYPE est incorrect
  180. *
  181.          ELSE
  182.             CALL ERREUR(484)
  183.             RETURN
  184.          ENDIF
  185. *
  186. *     3/ Cas oº la base modale est d{finie
  187. *               et les matrices masse et rigidit{ sont d{finies
  188. *
  189.       ELSE IF (ITBAS.NE.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN
  190.          CALL ERREUR(478)
  191.          RETURN
  192. *
  193. * table pasapas
  194.       ELSE IF (LMODYN) THEN
  195.         mmodel = itbas
  196.         segact mmodel
  197.         do im = 1,kmodel(/1)
  198.           imodel = kmodel(im)
  199.           segact imodel
  200.           if (nefmod.ne.45) goto 45
  201.           meleme = imamod
  202.           segact meleme
  203.           do ip = 1,num(/2)
  204.             knoe = num(1,ip)
  205.             IF (KNOE.NE.0) THEN
  206.                IF (ICPR(KNOE).EQ.0) THEN
  207.                   IK = IK + 1
  208.                   ICPR(KNOE) = IK
  209.       IF (IIMPI.EQ.333) THEN
  210.       WRITE(IOIMP,*)'DYNE25 : basemo. ICPR(',KNOE,')=',ICPR(KNOE)
  211.       ENDIF
  212.                ENDIF
  213.             ENDIF
  214.           enddo
  215.          segdes meleme
  216.  45      continue
  217.          segdes imodel
  218.         enddo
  219.         segdes mmodel
  220.       ENDIF
  221. *
  222. *     5/ Cr{ation du segment d{finissant les points supports:
  223. *
  224.       NPREF = IK
  225.       SEGINI,MPREF
  226.       KPREF = MPREF
  227.       IF (IIMPI.EQ.333) WRITE(IOIMP,*)'DYNE13 : KPREF=',KPREF,NPREF
  228.       DO 100 I=1,LCPR
  229.          IF (ICPR(I).NE.0) THEN
  230.             IREF = ICPR(I)
  231.             IPOREF(IREF) = I
  232.             IF (IIMPI.EQ.333) THEN
  233.                WRITE(IOIMP,*)'DYNE13 : IPOREF(',IREF,')=',IPOREF(IREF)
  234.             ENDIF
  235.          ENDIF
  236.  100     CONTINUE
  237. *     end do
  238. *
  239.       END
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  

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