Télécharger la plaquette Cast3M


fr en

Télécharger dyne19.eso

Retour à la liste

Numérotation des lignes : 

dyne19

  1. C DYNE19    SOURCE    BP208322  20/08/17    21:15:19     10692          
  2.       SUBROUTINE DYNE19(ILIA,KCPR,PDT,KTLIAA,IALGO)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Operateur DYNE :                                               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Remplissage des tableaux de description des liaisons sur       *
  11. *     la base a partir des informations contenues dans la            *
  12. *     table ILIA.                                                    *
  13. *                                                                    *
  14. *     Parametres:                                                    *
  15. *                                                                    *
  16. * e   ILIA    Table rassemblant la description des liaisons          *
  17. * e   KCPR    Segment descriptif des points.                         *
  18. * e   PDT     Pas de temps.                                          *
  19. * es  KTLIAA  Segment descriptif des liaisons sur la base A.         *
  20. *                                                                    *
  21. *     Parametres de dimensionnement pour une liaison sur base:       *
  22. *                                                                    *
  23. *     NIPALA : nombre de parametres pour definir le type des         *
  24. *              liaisons (NIPALA est fixe a 3).                       *
  25. *     NXPALA : nombre maxi de parametres internes pour definir       *
  26. *              les liaisons.                                         *
  27. *     NPLAA  : nombre maxi de points intervenant dans une liaison.   *
  28. *                                                                    *
  29. *     NPLA   : nombre total de points.                               *
  30. *     NLIAA  : nombre total de liaisons.                             *
  31. *                                                                    *
  32. *                                                                    *
  33. *     Tableaux fortran pour les liaisons sur base:                   *
  34. *                                                                    *
  35. *     XPALA(NLIAA,NXPALA) : parametres de la liaison.                *
  36. *     IPALA(NLIAA,NIPALA) : renseigne sur le type de liaison.        *
  37. *     JPLIA(NPLA)         : numero global des points.                *
  38. *     IPLIA(NLIAA,NPLAA)  : numeros locaux des points concernes par  *
  39. *                           la liaison.                              *
  40. *                                                                    *
  41. *     Auteur, date de creation:                                      *
  42. *                                                                    *
  43. *     Lionel VIVAN, le 21 aout 1989.                                 *
  44. *                                                                    *
  45. *--------------------------------------------------------------------*
  46. *
  47.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50. -INC CCNOYAU
  51. -INC SMCOORD
  52. -INC SMTABLE
  53. -INC CCASSIS
  54. -INC SMLREEL 
  55. *
  56.       SEGMENT,ICPR(nbpts)
  57. *
  58.       SEGMENT MTLIAA
  59.          INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  60.          REAL*8 XPALA(NLIAA,NXPALA)
  61.       ENDSEGMENT
  62.       SEGMENT  icorres (nliaa)
  63. *
  64.       LOGICAL L0,L1
  65.       CHARACTER*8  MONAMO,MONOBJ,TYPIND,TYPOBJ,CHARRE
  66.       CHARACTER*40 CMOT,MONMOT,CMOT2
  67.       CHARACTER*(20) CHAI1
  68.       CHARACTER*(18) CHAI2
  69.       CHARACTER*(15) CHAI3
  70.       CHARACTER*(16) CHAI4
  71.       CHARACTER*(14) CHAI5
  72.       CHARACTER*(11) CHAI6
  73.       PARAMETER (XZERO = 0.D0)
  74.       DATA CHAI1 /'EXPOSANT_DEPLACEMENT'/
  75.       DATA CHAI2 /'RETARD_DEPLACEMENT'/
  76.       DATA CHAI3 /'JEU_DEPLACEMENT'/
  77.       DATA CHAI4 /'EXPOSANT_VITESSE'/
  78.       DATA CHAI5 /'RETARD_VITESSE'/
  79.       DATA CHAI6 /'JEU_VITESSE'/
  80. *
  81.       ICPR = KCPR
  82.       MTLIAA = KTLIAA
  83.       NLIAA = IPALA(/1)
  84.       NXPALA = XPALA(/2)
  85.       NIPALA = IPALA(/2)
  86.       NPLAA = IPLIA(/2)
  87.       NPLA = JPLIA(/1)
  88.       XPDTS2 = 0.5 * PDT
  89.  
  90.        segini icorres
  91. *
  92. *     Boucle sur le nombre de liaisons
  93. *
  94.       II = 0
  95.       DO 10 I = 1,NLIAA
  96.          CALL ACCTAB(ILIA,'ENTIER',I,X0,'  ',L0,IP0,
  97.      &                      'TABLE',I0,X0,'  ',L1,ITLIAI)
  98.          IF (IERR.NE.0) RETURN
  99.           icorres ( i ) = itliai
  100.  
  101.          CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  102.      &                      'MOT',I1,X0,MONMOT,L1,IP1)
  103.          IF (IERR.NE.0) RETURN
  104. *
  105. *        Liaison elementaire
  106. *
  107.          IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN
  108.             CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
  109.      &                         'MOT',I1,X0,CMOT,L1,IP1)
  110.             IF (IERR.NE.0) RETURN
  111. *
  112.             IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
  113. *
  114. * ------------ choc POINT_PLAN_FLUIDE
  115. *
  116.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  117.      &                            'POINT',I1,X1,'  ',L1,IMOD)
  118.                IF (IERR.NE.0) RETURN
  119.                CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_INERTIE',
  120.      &                     L0,IP0,'FLOTTANT',I0,XINER,'  ',L1,IP1)
  121.                IF (IERR.NE.0) RETURN
  122.                CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_CONVECTION',
  123.      &                     L0,IP0,'FLOTTANT',I0,XCONV,'  ',L1,IP1)
  124.                IF (IERR.NE.0) RETURN
  125.                CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_VISCOSITE',
  126.      &                     L0,IP0,'FLOTTANT',I0,XVISC,'  ',L1,IP1)
  127.                IF (IERR.NE.0) RETURN
  128.                CALL ACCTAB(ITLIAI,'MOT',I1,X0,
  129.      &                     'COEFFICIENT_P_D_C_ELOIGNEMENT',L0,IP0,
  130.      &                     'FLOTTANT',I0,XPCEL,'  ',L1,IP1)
  131.                IF (IERR.NE.0) RETURN
  132.                CALL ACCTAB(ITLIAI,'MOT',I1,X0,
  133.      &                     'COEFFICIENT_P_D_C_RAPPROCHEMENT',L0,IP0,
  134.      &                     'FLOTTANT',I0,XPCRA,'  ',L1,IP1)
  135.                IF (IERR.NE.0) RETURN
  136.                CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU_FLUIDE',L0,IP0,
  137.      &                            'FLOTTANT',I0,XJEU,'  ',L1,IP1)
  138.                IF (IERR.NE.0) RETURN
  139. *
  140.                IPALA(I,1) = 3
  141.                XPALA(I,1) = XINER
  142.                XPALA(I,2) = XCONV
  143.                XPALA(I,3) = XVISC
  144.                XPALA(I,4) = XPCEL
  145.                XPALA(I,5) = XPCRA
  146.                XPALA(I,6) = XJEU
  147.                IK = ICPR(IMOD)
  148.                IPLIA(I,1) = IK
  149.                JPLIA(IK) = IMOD
  150.  
  151.  
  152.             ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
  153.                MONAMO = '        '
  154.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
  155.      &                            MONAMO,I1,XAMO,CHARRE,L1,IP1)
  156.                IF (IERR.NE.0) RETURN
  157. *
  158. * ------------ choc POINT_PLAN avec amortissement
  159. *
  160.                IF (MONAMO.EQ.'FLOTTANT') THEN
  161.                   CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  162.      &                               'POINT',I1,X1,'  ',L1,IMOD)
  163.                   IF (IERR.NE.0) RETURN
  164.                   CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  165.      &                        'FLOTTANT',I0,XRAID,'  ',L1,IP1)
  166.                   IF (IERR.NE.0) RETURN
  167.                   CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0,
  168.      &                        'FLOTTANT',I0,XJEU,'  ',L1,IP1)
  169.                   IF (IERR.NE.0) RETURN
  170. *
  171.                   IPALA(I,1) = 2
  172.                   XPALA(I,1) = XRAID
  173.                   XPALA(I,2) = XJEU
  174.                   XPALA(I,3) = XAMO
  175.                   IK = ICPR(IMOD)
  176.                   IPLIA(I,1) = IK
  177.                   JPLIA(IK) = IMOD
  178. *
  179. * ------------ choc POINT_PLAN sans amortissement
  180. *
  181.                ELSE
  182.                   CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  183.      &                         'POINT',I1,X1,'  ',L1,IMOD)
  184.                   IF (IERR.NE.0) RETURN
  185.                   CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0,
  186.      &                        'FLOTTANT',I0,XRAID,'  ',L1,IP1)
  187.                   IF (IERR.NE.0) RETURN
  188.                   CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0,
  189.      &                       'FLOTTANT',I0,XJEU,'  ',L1,IP1)
  190.                   IF (IERR.NE.0) RETURN
  191. *
  192.                   IPALA(I,1) = 1
  193.                   XPALA(I,1) = XRAID
  194.                   XPALA(I,2) = XJEU
  195.                   IK = ICPR(IMOD)
  196.                   IPLIA(I,1) = IK
  197.                   JPLIA(IK) = IMOD
  198.                ENDIF
  199. *
  200. * --------- liaison de couplage en vitesse
  201. *
  202.             ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN
  203.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  204.      &                            'POINT',I1,X1,'  ',L1,ISUPP)
  205.                IF (IERR.NE.0) RETURN
  206.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0,
  207.      &                            'POINT',I1,X1,'  ',L1,IORIG)
  208.                IF (IERR.NE.0) RETURN
  209.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
  210.      &                            'FLOTTANT',I1,XCPLGE,'  ',L1,IP1)
  211.                IF (IERR.NE.0) RETURN
  212. *
  213.                IPALA(I,1) = 4
  214.                XPALA(I,1) = XCPLGE
  215.                IKX = ICPR(ISUPP)
  216.                IPLIA(I,1) = IKX
  217.                JPLIA(IKX) = ISUPP
  218.                IKY = ICPR(IORIG)
  219.                IPLIA(I,2) = IKY
  220.                JPLIA(IKY) = IORIG
  221. *
  222. * --------- liaison de couplage en deplacement
  223. *
  224.             ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN
  225.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  226.      &                            'POINT',I1,X1,'  ',L1,ISUPP)
  227.                IF (IERR.NE.0) RETURN
  228.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0,
  229.      &                            'POINT',I1,X1,'  ',L1,IORIG)
  230.                IF (IERR.NE.0) RETURN
  231.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
  232.      &                            'FLOTTANT',I1,XCPLGE,'  ',L1,IP1)
  233.                IF (IERR.NE.0) RETURN
  234. *
  235.                IPALA(I,1) = 5
  236.                XPALA(I,1) = XCPLGE
  237.                IKX = ICPR(ISUPP)
  238.                IPLIA(I,1) = IKX
  239.                JPLIA(IKX) = ISUPP
  240.                IKY = ICPR(IORIG)
  241.                IPLIA(I,2) = IKY
  242.                JPLIA(IKY) = IORIG
  243. *
  244. *              lectures facultatives EXPOSANT OU FONCTION
  245.                TYPOBJ = ' '
  246.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'EXPOSANT',L0,IP0,
  247.      &                            TYPOBJ,I1,XEXPO,'  ',L1,IP1)
  248.                IF (IERR.NE.0) RETURN
  249.                IF(TYPOBJ.EQ.'ENTIER') THEN
  250.                  XPALA(I,2) = DBLE(I1)
  251.                ELSEIF(TYPOBJ.EQ.'FLOTTANT') THEN
  252.                  XPALA(I,2) = XEXPO
  253.                ELSE
  254.                  XPALA(I,2) = 1.D0
  255. *                lectures facultatives FONCTION
  256.                  TYPOBJ = ' '
  257.                  CALL ACCTAB(ITLIAI,'MOT',I0,X0,'FONCTION',L0,IP0,
  258.      &                              TYPOBJ,I1,X1,CHARRE,L1,IP1)
  259.                  IF (IERR.NE.0) RETURN
  260.                  IF(TYPOBJ.EQ.'MOT') THEN
  261. c                  uniquement fonctions trigonometriques
  262.                    IF(CHARRE.EQ.'COS') THEN
  263.                      IPALA(I,3) = 1
  264.                    ELSEIF(CHARRE.EQ.'SIN') THEN
  265.                      IPALA(I,3) = 2
  266.                    ELSE
  267.                      WRITE(IOIMP,*) 'FONCTION non reconnue !'
  268.                      CALL ERREUR(21)
  269.                      RETURN
  270.                    ENDIF
  271. c                  fontions de q ou du temps ?
  272.                    IF(IPALA(I,3).EQ.1.OR.IPALA(I,3).EQ.2) THEN
  273.                      TYPOBJ = ' '
  274.                      CALL ACCTAB(ITLIAI,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  275.      &                                  TYPOBJ,IFREQ,XFREQ,'  ',L1,IP1)
  276.                      IF (IERR.NE.0) RETURN
  277. c                   -il s'agit de cos(wt)*q
  278.                      IF(TYPOBJ.EQ.'FLOTTANT') THEN
  279.                        XPALA(I,2) = XFREQ
  280.                        IPALA(I,3) = IPALA(I,3) + 10
  281.                      ELSEIF(TYPOBJ.EQ.'ENTIER') THEN
  282.                        XPALA(I,2) = DBLE(IFREQ)
  283.                        IPALA(I,3) = IPALA(I,3) + 10
  284. c                   -il s'agit de cos(q) --> on ne fait rien
  285. c                      ELSE
  286.                      ENDIF
  287.                    ENDIF
  288.                  ENDIF
  289.                ENDIF
  290. *
  291. *              lectures facultatives FONCTION_CONVOLUTION
  292.                TYPOBJ = ' '
  293.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'FONCTION_CONVOLUTION',
  294.      &                            L0,IP0,TYPOBJ,I1,X1,CMOT2,L1,IP1)
  295.                IF (IERR.NE.0) RETURN
  296.                IF(TYPOBJ.EQ.'LISTREEL') THEN
  297. c                  write(*,*) 'dyne19: FONCTION_CONVOLUTION+LISTREEL' 
  298. c                on signale le type de fonction
  299.                  IPALA(I,3) = 100
  300. c                on recupere et active le listreel h(\tau_k)
  301.                  IPALA(I,4)=IP1
  302.                  MLREE1=IP1
  303.                  segact,MLREE1
  304. c                on cree et initialise le listreel x(t-\tau_k)
  305.                  JG=MLREE1.PROG(/1)
  306. c               write(*,*) 'dyne19: LISTREEL=',(MLREE1.PROG(iou),iou=1,3)
  307. c      &              ,'...',JG
  308.                  segini,MLREE2
  309.                  IP2=MLREE2
  310.                  IPALA(I,5)=IP2
  311. c                + listreel des demi-pas x(t-\tau_k) avec t={t_n+1/2 ...}
  312.                  segini,MLREE3
  313.                  IP3=MLREE3
  314.                  IPALA(I,6)=IP3
  315. c                si reprise, on remplira ces 2 derniers listreels dans dyna14
  316.                ELSEIF(TYPOBJ.EQ.'MOT') THEN
  317.                  IF (CMOT2.EQ.'GRANGER_PAIDOUSSIS') THEN
  318.                    CALL ACCTAB(ITLIAI,'MOT',I0,X0,'VITESSE',L0,IP0,
  319.      &                                'FLOTTANT',I1,XVIT1,CMOT2,L1,IP1)
  320.                    IF (IERR.NE.0) RETURN
  321.                    CALL ACCTAB(ITLIAI,'MOT',I0,X0,'DIAMETRE',L0,IP0,
  322.      &                                'FLOTTANT',I1,XDIA1,CMOT2,L1,IP1)
  323.                    IF (IERR.NE.0) RETURN
  324.                    CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ALPHA',L0,IP0,
  325.      &                                'LISTREEL',I1,X1,CMOT2,L1,IP1)
  326.                    IF (IERR.NE.0) RETURN
  327.                    CALL ACCTAB(ITLIAI,'MOT',I0,X0,'DELTA',L0,IP0,
  328.      &                                'LISTREEL',I1,X1,CMOT2,L1,IP2)
  329.                    IF (IERR.NE.0) RETURN
  330. c                    write(*,*) '>dyne19: FONCTION_CONVOLUTION+GRANGER' 
  331. c                  on signale le type de fonction
  332.                    IPALA(I,3) = 101
  333. c                  on recupere et active les listreel alpha_i et delta_i
  334.                    MLREE1=IP1
  335.                    segact,MLREE1
  336.                    JG1=MLREE1.PROG(/1)
  337.                    MLREE2=IP2
  338.                    segact,MLREE2
  339.                    JG2=MLREE2.PROG(/1)
  340.                    IF(JG1.NE.JG2) THEN
  341.                      MOTERR(1:8)='LISTREEL'
  342.                      CALL ERREUR(1015)
  343.                      RETURN
  344.                    ENDIF
  345. c                    IPALA(I,4)=IP1
  346. c                    IPALA(I,5)=IP2
  347. c                  --> optimisation par precalcul :
  348. c                  on cree 1 listreel + efficace que alpha et delta
  349. c                  contenant a_i*d_i ,  EXP(+AUX) et EXP(-AUX)
  350. c                  ok tant que le PDT est constant
  351.                    JG=3*JG1
  352.                    segini,MLREEL
  353.                    do ig1=1,jg1
  354.                      XALPH=MLREE1.PROG(ig1)
  355.                      XDELT=MLREE2.PROG(ig1)
  356.                      prog(ig1)=XALPH*XDELT
  357. c                    pour differences_centrees:
  358.                      AUX=XDELT*XVIT1/XDIA1*PDT
  359. c                    pour de_vogelaere on prend dt/2:
  360.                      if (IALGO.EQ.1) AUX=AUX*0.5D0
  361.                      prog(ig1+JG1)=EXP(AUX)
  362.                      prog(ig1+2*JG1)=EXP(-1.D0*AUX)
  363.                    enddo
  364.                    IPALA(I,4)=MLREEL
  365.                    IPALA(I,5)=0
  366. c                  on cree et initialise le listreel y(t_n-1)_i
  367.                    JG=JG1
  368.                    segini,MLREEL
  369. c                    IPALA(I,6)=MLREEL
  370.                    IPALA(I,5)=MLREEL
  371. c                  + listreel de S_i(t_n-1) = integrale de y(t_n-1)_i 
  372.                    segini,MLREEL
  373. c                    IPALA(I,7)=MLREEL
  374.                    IPALA(I,6)=MLREEL
  375. c                  si reprise, on remplira ces 2 derniers listreels dans dyna14                
  376. c                  il reste le rapport V/D
  377.                    XPALA(I,2)=XVIT1/XDIA1
  378. c                  et la constante alpha0 = 1 - \sum_i alpha_i
  379.                    XALPH0=1.D0
  380.                    DO IG1=1,JG1
  381.                      XALPH0=XALPH0-MLREE1.PROG(IG1)
  382.                    ENDDO
  383.                    XPALA(I,3)=XALPH0
  384.                  ENDIF
  385.                ENDIF
  386.  
  387. *
  388. * --------- liaison de type force POLYNOMIALE
  389. *
  390.             ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN
  391.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
  392.      &                            'POINT',I1,X1,' ',L1,ISUPP)
  393.                IF (IERR.NE.0) RETURN
  394.                CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
  395.      &                            'FLOTTANT',I1,XCOEF,' ',L1,IP1)
  396.                IF (IERR.NE.0) RETURN
  397. *         on met un flag reconnaissable ( cf dypol1) pour
  398. *               reconnaissance du temps de demmarrage de la liaison
  399.          do 101 ip = 1 , nxpala
  400.           xpala(i,ip) = 123456.7
  401.  101     continue
  402.  
  403.                IPALA(I,1) = 6
  404.                IKX = ICPR(ISUPP)
  405.                IPLIA(I,1) = IKX
  406.                JPLIA(IKX) = ISUPP
  407.                XPALA(I,1) = XCOEF
  408.         MTABLE = ITLIAI
  409.                SEGACT MTABLE
  410.                NIND1 = MLOTAB
  411. *
  412. *              contributions des autres modes
  413. *
  414.                K1 = 2
  415.                K2 = 1
  416.                if(nbesc.ne.0) segact ipiloc
  417.                DO 20 J=1,NIND1
  418. *                 valeurs nulles par defaut
  419.                   XPALA(I,K1) = 0d0
  420.                   XPALA(I,K1+1) = 0d0
  421.                   XPALA(I,K1+2) = 0d0
  422.                   XPALA(I,K1+3) = 0d0
  423.                   XPALA(I,K1+4) = 0d0
  424.                   XPALA(I,K1+5) = 0d0
  425.                   TYPIND = MTABTI(J)
  426.                   IF (TYPIND.EQ.'POINT   ') THEN
  427.                      TYPOBJ = MTABTV(J)
  428.                      IF (TYPOBJ.EQ.'TABLE   ') THEN
  429.                         K2 = K2 + 1
  430.                         IORIG = MTABII(J)
  431.                         IKX = ICPR(IORIG)
  432.                         IPLIA(I,K2) = IKX
  433.                         JPLIA(IKX) = IORIG
  434.                         MTAB1 = MTABIV(J)
  435.                         SEGACT MTAB1
  436.                         NIND2 = MTAB1.MLOTAB
  437.                         RD = XZERO
  438.                         RV = XZERO
  439.                         DO 30 K=1,NIND2
  440.                            TYPIND = MTAB1.MTABTI(K)
  441.                            IF (TYPIND.EQ.'MOT     ') THEN
  442.                               IP = MTAB1.MTABII(K)
  443.                               ID = IPCHAR(IP)
  444.                               IFI = IPCHAR(IP+1)
  445.                               IL1 = IFI - ID
  446.                               IF (IL1.EQ.20) THEN
  447. c                                EXPOSANT_DEPLACEMENT
  448.                                  IF (CHAI1.EQ.ICHARA(ID:ID+19)) THEN
  449.                                     TYPOBJ = MTAB1.MTABTV(K)
  450.                                     IF (TYPOBJ.EQ.'FLOTTANT') THEN
  451.                                        XPALA(I,K1) = MTAB1.RMTABV(K)
  452.                                     ENDIF
  453.                                  ENDIF
  454.                               ELSE IF (IL1.EQ.18) THEN
  455. c                                RETARD_DEPLACEMENT
  456.                                  IF (CHAI2.EQ.ICHARA(ID:ID+17)) THEN
  457.                                     TYPOBJ = MTAB1.MTABTV(K)
  458.                                     IF (TYPOBJ.EQ.'FLOTTANT') THEN
  459.                                        RD = MTAB1.RMTABV(K)
  460.                                        XPALA(I,K1+1) = RD
  461.                                     ENDIF
  462.                                  ENDIF
  463.                               ELSE IF (IL1.EQ.15) THEN
  464. c                                JEU_DEPLACEMENT
  465.                                  IF (CHAI3.EQ.ICHARA(ID:ID+14)) THEN
  466.                                     TYPOBJ = MTAB1.MTABTV(K)
  467.                                     IF (TYPOBJ.EQ.'FLOTTANT') THEN
  468.                                        XPALA(I,K1+2) = MTAB1.RMTABV(K)
  469.                                     ENDIF
  470.                                  ENDIF
  471.                               ELSE IF (IL1.EQ.16) THEN
  472. c                                EXPOSANT_VITESSE
  473.                                  IF (CHAI4.EQ.ICHARA(ID:ID+15)) THEN
  474.                                     TYPOBJ = MTAB1.MTABTV(K)
  475.                                     IF (TYPOBJ.EQ.'FLOTTANT') THEN
  476.                                        XPALA(I,K1+3) = MTAB1.RMTABV(K)
  477.                                     ENDIF
  478.                                  ENDIF
  479.                               ELSE IF (IL1.EQ.14) THEN
  480. c                                RETARD_VITESSE
  481.                                  IF (CHAI5.EQ.ICHARA(ID:ID+13)) THEN
  482.                                     TYPOBJ = MTAB1.MTABTV(K)
  483.                                     IF (TYPOBJ.EQ.'FLOTTANT') THEN
  484.                                        RV = MTAB1.RMTABV(K)
  485.                                        XPALA(I,K1+4) = RV
  486.                                     ENDIF
  487.                                  ENDIF
  488.                               ELSE IF (IL1.EQ.11) THEN
  489. c                                JEU_VITESSE
  490.                                  IF (CHAI6.EQ.ICHARA(ID:ID+10)) THEN
  491.                                     TYPOBJ = MTAB1.MTABTV(K)
  492.                                     IF (TYPOBJ.EQ.'FLOTTANT') THEN
  493.                                        XPALA(I,K1+5) = MTAB1.RMTABV(K)
  494.                                     ENDIF
  495.                                  ENDIF
  496.                               ENDIF
  497.                            ENDIF
  498.  30                     CONTINUE
  499.                         ND = INT(RD/XPDTS2) + 1
  500.                         NV = INT(RV/XPDTS2) + 2
  501.                         NMAX = MAX(ND,NV)
  502.                         K1 = K1 + 6 + NMAX
  503.                      ENDIF
  504.                   ENDIF
  505.  20            CONTINUE
  506.                if(nbesc.ne.0)SEGDES,IPILOC
  507.                SEGDES MTABLE
  508. *
  509. *              Nombre de modes "origine"
  510. *
  511.                IPALA(I,2) = K2 - 1
  512. *
  513. * --------- choc ...........
  514. *
  515. *           ELSE IF (CMOT(1:  ).EQ.'                ') THEN
  516. *              .......
  517. *              .......
  518. *
  519.             ELSE
  520.                CALL ERREUR(490)
  521.                RETURN
  522.             ENDIF
  523. *
  524. *        Liaison ...........
  525. *
  526. *        ELSE IF (MONMOT(1:  ).EQ.'                ') THEN
  527. *           .......
  528. *           .......
  529. *
  530.          ELSE
  531.             CALL ERREUR(489)
  532.             RETURN
  533.          ENDIF
  534.  10      CONTINUE
  535. *
  536. *
  537. *
  538. *   ----- liaisons conditionnelles ?
  539. *
  540. *
  541.       DO 11 I = 1,NLIAA
  542.          ksi = 0
  543.          CALL ACCTAB(ILIA,'ENTIER',I,X0,'  ',L0,IP0,
  544.      &                    'TABLE',I0,X0,'  ',L1,ITLIAI)
  545.  
  546.          DO 111 j = 1,NLIAA
  547.            jtliai = icorres ( j )
  548.            monmot = ' '
  549.            CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai,
  550.      &                        monmot,I1,X0,CHARRE,L1,IP1)
  551.            IF (IERR.NE.0) RETURN
  552. *          ------- si on trouve un logique en face d'une table
  553. *                     de liaison  , c'est bon
  554.            IF (MONMOT.EQ.'LOGIQUE ') THEN
  555.               ksi = ksi + 1
  556.               ipala(i,2) = 1
  557.               IF (L1 ) tHEN
  558.                 ipala (i,3+ksi) = j
  559.               ELSE IF (.NOT.  L1) THEN
  560.                 ipala (i,3+ksi) = -1 * j
  561.               ENDIF
  562.            ENDIF
  563.  111     CONTINUE
  564.  11      CONTINUE
  565. *
  566. *
  567. *
  568. *
  569. *     end do
  570.       IF (IIMPI.EQ.333) THEN
  571.       DO 1000 IN = 1,NLIAA
  572.          DO 1002 II = 1,NIPALA
  573.          WRITE(IOIMP,*)'DYNE19 : IPALA(',IN,',',II,') =',IPALA(IN,II)
  574.  1002    CONTINUE
  575.          DO 1004 IX = 1,NXPALA
  576.          WRITE(IOIMP,*)'DYNE19 : XPALA(',IN,',',IX,') =',XPALA(IN,IX)
  577.  1004    CONTINUE
  578.          DO 1006 IP = 1,NPLAA
  579.          WRITE(IOIMP,*)'DYNE19 : IPLIA(',IN,',',IP,') =',IPLIA(IN,IP)
  580.  1006    CONTINUE
  581.  1000 CONTINUE
  582.       DO 1008 IP = 1,NPLA
  583.          WRITE(IOIMP,*)'DYNE19 : JPLIA(',IP,') =',JPLIA(IP)
  584.  1008 CONTINUE
  585.       ENDIF
  586. *
  587.       END
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  

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