Télécharger la plaquette Cast3M


fr en

Télécharger devlir.eso

Retour à la liste

Numérotation des lignes : 

devlir

  1. C DEVLIR    SOURCE    CB215821  24/04/12    21:15:36     11897          
  2.       SUBROUTINE DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,
  3.      &            NINS,ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Lecture et coherence des operandes, verification des supports  *
  12. *     objets TBAS, TKM, TA et TINIT.                                 *
  13. *     Obtention de la liste des points de reference.                 *
  14. *                                                                    *
  15. *     Param}tres:                                                    *
  16. *                                                                    *
  17. * s   ITBAS   Table representant une base modale                     *
  18. * s   ITKM    Table contenant les matrices de raideur et de masse    *
  19. * s   ITA     Table contenant la matrice des amortissements          *
  20. * s   ITLIA   Table rassemblant la description des liaisons          *
  21. * s   ITCHAR  Table contenant les chargements                        *
  22. * s   ITINIT  Table donnant les conditions initiales                 *
  23. * s   NP      Nombre de pas de temps                                 *
  24. * s   PDT     Valeur du pas de temps                                 *
  25. * s   NINS    On veut un resultat tous les NINS pas de calcul        *
  26. * s   ITSORT  Table definissant les resultats attendus               *
  27. * s   ITREDU  Table contenant les noms d'inconnues de la base B      *
  28. *             auxquelles on se restreint                             *
  29. * s   KPREF   Segment des points de reference                        *
  30. * s   KCPR    Segment des points                                     *
  31. *                                                                    *
  32. *     Auteur, date de creation:                                      *
  33. *                                                                    *
  34. *     Denis ROBERT-MOUGIN, le 25 mai 1989.                           *
  35. *                                                                    *
  36. *--------------------------------------------------------------------*
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMMODEL
  41.       segment mwinit
  42.         integer jpdep,jpvit,jrepr
  43.       endsegment
  44.       segment mtbas
  45.         integer itbmod,lsstru(np1),nsstru
  46.       endsegment
  47. *
  48.       PARAMETER ( ZERO=0.D0 )
  49.       LOGICAL LMODYN, LOAMOR,L0,L1
  50.       CHARACTER*8 TYPOBJ
  51.       CHARACTER*72 CHARRE,CHARRI
  52. *
  53.       NINS = 1
  54.       LMODYN = .false.
  55.       ITDYN = 0
  56. *
  57.       ITBAS  = 0
  58.       ITKM   = 0
  59.       ITA    = 0
  60.       ITLIA  = 0
  61.       ITCHAR = 0
  62.       ITINIT = 0
  63.       ITSORT = 0
  64.       ITREDU = 0
  65.       ITINV = 0
  66.       ITIND = 0
  67.  
  68.       CALL LIRTAB('PASAPAS',ITDYN,0,IRET)
  69.            if (iret.ne.0) lmodyn = .true.
  70. *
  71. *     A/ Lecture des operandes, les tables puis les autres:
  72. *
  73.         if (lmodyn) then
  74.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'MODELE',L0,IP0,
  75.      &                    'MMODEL',I1,X1,CHARRE,L1,ITMOD)
  76.           IF (IERR.NE.0) RETURN
  77.         CALL ACCTAB(ITDYN,'MOT',IM,X0,'CARACTERISTIQUES',L0,IP0,
  78.      &                'MCHAML',I1,X1,CHARRE,L1,ITCARA)
  79.           IF (IERR.NE.0) RETURN
  80.           call ecrcha('MECANIQUE')
  81.           call ecrcha('FORM')
  82.           call ecrobj('MMODEL',ITMOD)
  83.           call extrai
  84.           call lirobj('MMODEL  ',ITMO1,0,iret)
  85.           mmodel = itmod
  86.           segact mmodel
  87.           np1 = kmodel(/1)
  88.           segini mtbas
  89.           itbas = mtbas
  90.           itbmod = itmo1
  91.         else
  92.       CALL MESLIR(-261)
  93.       CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET)
  94.       IF (IRET.EQ.0) THEN
  95.          CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,0,IRET)
  96.       ENDIF
  97.       IF (IERR.NE.0) RETURN
  98.       IF (ITBAS.NE.0 .AND. IIMPI.EQ.333) THEN
  99.       WRITE(IOIMP,*)'   on a lu la table definissant la base modale.'
  100.       ENDIF
  101.         endif
  102. *
  103.  
  104.         if (lmodyn) then
  105.         else
  106.       CALL MESLIR(-262)
  107.       CALL LIRTAB('RAIDEUR_ET_MASSE',ITKM,0,IRET)
  108.       IF (IERR.NE.0) RETURN
  109.       IF (ITKM.NE.0 .AND. IIMPI.EQ.333) THEN
  110.       WRITE(IOIMP,*)
  111.      & '   on a lu la table definissant les matrices de raideurs.'
  112.       ENDIF
  113.         endif
  114. *
  115.         if (lmodyn) then
  116.           ITBMO1 = itbmod
  117.           CALL ACTOBJ('MCHAML  ',ITCARA,1)
  118.           CALL ACTOBJ('MMODEL  ',ITBMO1,1)
  119.           CALL REDUAF(ITCARA,ITBMO1,ipche1,0,IR,KER)
  120.           IF(IR   .NE. 1) CALL ERREUR(KER)
  121.           IF(IERR .NE. 0) RETURN
  122.  
  123.           call ecrcha('AMOR')
  124.           call ecrobj('MCHAML',ipche1)
  125.           call exis
  126.           call lirlog(loamor,1,iret)
  127.           if (loamor) then
  128.             call ecrobj('MCHAML',itcara)
  129.             call ecrobj('MMODEL',itmod)
  130.             call amor
  131.             call lirobj('RIGIDITE',ITA,1,iret)
  132.             IF (IERR.NE.0) RETURN
  133.           endif
  134.         else
  135.       CALL MESLIR(-263)
  136.       CALL LIRTAB('AMORTISSEMENT',ITA,0,IRET)
  137.       IF (IERR.NE.0) RETURN
  138.       IF (ITA.NE.0 .AND. IIMPI.EQ.333) THEN
  139.       WRITE(IOIMP,*)
  140.      & '   on a lu la table definissant une matrice d''amortissement.'
  141.       ENDIF
  142.         endif
  143. *
  144.         if (lmodyn) then
  145.           call ecrcha('LIAISON')
  146.           call ecrcha('FORM')
  147.           call ecrobj('MMODEL',ITMOD)
  148.           call exis
  149.           call lirobj('LOGIQUE',itlog,0,iret)
  150.  
  151.           if (itlog.eq.1) then
  152.            call ecrcha('LIAISON')
  153.            call ecrcha('FORM')
  154.            call ecrobj('MMODEL',ITMOD)
  155.            call extrai
  156.            call lirobj('MMODEL',itlia,0,iret)
  157.           endif
  158.           if (ierr.ne.0) return
  159.         else
  160.       CALL MESLIR(-264)
  161.       CALL LIRTAB('LIAISON',ITLIA,0,IRET)
  162.       IF (IERR.NE.0) RETURN
  163.       IF (ITLIA.NE.0 .AND. IIMPI.EQ.333) THEN
  164.       WRITE(IOIMP,*)'   on a lu la table definissant les liaisons.'
  165.       ENDIF
  166.         endif
  167. *
  168.         if (lmodyn) then
  169.            typobj = ' '
  170.            irep = 0
  171.            ITCHAR = 0
  172.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'CHARGEMENT',L0,IP0,
  173.      &                    typobj,I1,X1,CHARRE,L1,irep)
  174.           if (typobj.eq.'CHARGEME') ITCHAR = irep
  175.         else
  176.       CALL MESLIR(-265)
  177.       CALL LIRTAB('CHARGEMENT',ITCHAR,0,IRET)
  178.       IF (IERR.NE.0) RETURN
  179.       IF (ITCHAR.NE.0 .AND. IIMPI.EQ.333) THEN
  180.       WRITE(IOIMP,*)'   on a lu la table definissant les chargements.'
  181.       ENDIF
  182.         endif
  183. *
  184.         if (lmodyn) then
  185.            typobj = ' '
  186.            irep = 0
  187.            CALL ACCTAB(ITDYN,'MOT',IM,X0,'INIT_DYNE',L0,IP0,
  188.      &                    typobj,I1,X1,CHARRE,L1,IREP)
  189.  
  190.           if (typobj.eq.'TABLE') then
  191.               segini mwinit
  192.               itinit = mwinit
  193.               jrepr = irep
  194.           else
  195.            itinv = 0
  196.            itind = 0
  197.            typobj = ' '
  198.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'DEPLACEMENTS',L0,IP0,
  199.      &                    typobj,I1,X1,CHARRE,L1,ITAD)
  200.           if (typobj.eq.'TABLE') then
  201.           CALL ACCTAB(ITAD,'ENTIER',0,X0,' ',L0,IP0,
  202.      &                    'CHPOINT',I1,X1,CHARRE,L1,ITIND)
  203.           endif
  204.           typobj = ' '
  205.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'VITESSES',L0,IP0,
  206.      &                    typobj,I1,X1,CHARRE,L1,ITAV)
  207.           if (typobj.eq.'TABLE') then
  208.           CALL ACCTAB(ITAV,'ENTIER',0,X0,' ',L0,IP0,
  209.      &                    'CHPOINT',I1,X1,CHARRE,L1,ITINV)
  210.           endif
  211.           if(itinv.gt.0.or.itind.gt.0) then
  212.             segini mwinit
  213.             jpdep = itind
  214.             jpvit = itinv
  215.             itinit = mwinit
  216.           endif
  217.          endif
  218.         else
  219.       CALL MESLIR(-266)
  220.  
  221.       CALL LIRTAB('INITIAL',ITINIT,0,IRET)
  222.       IF (IERR.NE.0) RETURN
  223.       IF (ITINIT.NE.0 .AND. IIMPI.EQ.333) THEN
  224.       WRITE(IOIMP,*)
  225.      &'   on a lu la table definissant les conditions initiales.'
  226.       ENDIF
  227.         endif
  228.  
  229.         if (lmodyn) then
  230. * le traitement des reprises semble �tre fait dans devalo
  231.         else
  232.       CALL LIRTAB('REPRISE',IREP,0,IRET)
  233.       IF (IERR.NE.0) RETURN
  234.       IF (IREP.NE.0 .AND. IIMPI.EQ.333) THEN
  235.       WRITE(IOIMP,*)
  236.      &'   on a lu la table definissant la reprise'
  237.       ENDIF
  238.         endif
  239. *
  240.         if (lmodyn) then
  241.           ITSORT = 0
  242.           typobj = ' '
  243.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'SORTIE',L0,IP0,
  244.      &                    typobj,I1,X1,CHARRE,L1,ITSOR1)
  245.           if (typobj.eq.'TABLE') then
  246.            ITSORT = ITSOR1
  247.           endif
  248.         else
  249.       CALL MESLIR(-267)
  250.       CALL LIRTAB('SORTIE',ITSORT,0,IRET)
  251.       IF (IERR.NE.0) RETURN
  252.       IF (ITSORT.NE.0 .AND. IIMPI.EQ.333) THEN
  253.       WRITE(IOIMP,*)'   on a lu la table definissant les sorties.'
  254.       ENDIF
  255.         endif
  256. *
  257.         if (lmodyn) then
  258.         else
  259.       CALL MESLIR(-268)
  260.       CALL LIRTAB('RESTRICTION',ITREDU,0,IRET)
  261.       IF (IERR.NE.0) RETURN
  262.         endif
  263. *
  264.         if (lmodyn) then
  265.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_TEMPS',L0,IP0,
  266.      &                    'FLOTTANT',I1,pdt,CHARRE,L1,IP1)
  267.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'NOMBRE_PAS',L0,IP0,
  268.      &                    'ENTIER',np,X1,CHARRE,L1,IP1)
  269.  
  270.           typobj = ' '
  271.           nins = 1
  272.           CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_SORTIE',L0,IP0,
  273.      &                    typobj,I1,X1,CHARRE,L1,IP1)
  274.           if (typobj.eq.'ENTIER') nins = I1
  275.         else
  276.       CALL MESLIR(-269)
  277.       CALL LIRENT(NP,1,IRET)
  278.       IF (IERR.NE.0) RETURN
  279. *
  280.       CALL MESLIR(-270)
  281.       CALL LIRREE(PDT,1,IRET)
  282.       IF (IERR.NE.0) RETURN
  283. *
  284.       CALL MESLIR(-271)
  285.       CALL LIRENT(NINS,0,IRET)
  286.       IF (IERR.NE.0) RETURN
  287.         endif
  288. *
  289. *     B/ Coherence des operandes
  290. *
  291.       IF (ITBAS.EQ.0 .AND. ITKM.EQ.0) THEN
  292.          CALL ERREUR(478)
  293.          RETURN
  294.       ENDIF
  295.       IF (ITCHAR.EQ.0 .AND. ITINIT.EQ.0 .AND. IREP.EQ.0) THEN
  296.          CALL ERREUR(479)
  297.          RETURN
  298.       ENDIF
  299.       IF (NP.LE.0) THEN
  300.          IF(LANGUE.EQ.'ANGL') THEN
  301.            MOTERR(1:40)='time steps'
  302.          ELSE
  303.            MOTERR(1:40)='pas de temps de calcul'
  304.          ENDIF
  305.          CALL ERREUR(480)
  306.          RETURN
  307.       ENDIF
  308.       IF (PDT.LE.ZERO) THEN
  309.          CALL ERREUR(481)
  310.          RETURN
  311.       ENDIF
  312.       IF (NINS.LE.0) THEN
  313. *          INTERR(1)=NINS
  314. *          CALL ERREUR(36)
  315.          IF(LANGUE.EQ.'ANGL') THEN
  316.            MOTERR(1:40)='calculation steps between two outputs'
  317.          ELSE
  318.            MOTERR(1:40)='pas de calcul entre deux sorties'
  319.          ENDIF
  320.          CALL ERREUR(480)
  321.          RETURN
  322.       ENDIF
  323. *
  324. *     C/ Verification des supports des objets TBAS, TKM, TA et TINIT
  325. *        et obtention de la liste des points de reference
  326. *
  327.        if (lmodyn) then
  328.           it1 = itbmod
  329.        else
  330.           it1 = itbas
  331.        endif
  332.       CALL DYNE13(IT1,ITKM,KPREF,KCPR,LMODYN)
  333.       IF (IERR.NE.0) RETURN
  334. *
  335.       END
  336.  
  337.  
  338.  
  339.  
  340.  

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