Télécharger la plaquette Cast3M


fr en

Télécharger devlfa.eso

Retour à la liste

Numérotation des lignes : 

devlfa

  1. C DEVLFA    SOURCE    BP208322  20/09/18    21:15:38     10718          
  2.       SUBROUTINE DEVLFA(Q1,Q2,FTOTA,NA1,IPALA,IPLIA,XPALA,XVALA,
  3.      &                  NLIAA,PDT,T,NPAS,IND,FINERT,IVINIT,FTEST)
  4. cbp, supprime le 2020-08-07  ,FTOTA0)
  5.  
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8.  
  9. *--------------------------------------------------------------------*
  10. *                                                                    *
  11. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  12. *     ________________________________________________               *
  13. *                                                                    *
  14. *     Calcul des forces de choc base A.                              *
  15. *                                                                    *
  16. *     Parametres:                                                    *
  17. *                                                                    *
  18. * e   Q1(.,.) Vecteur des deplacements generalises.                  *
  19. * e   Q2(.,.) Vecteur des vitesses generalisees.                     *
  20. * es  FTOTA   Forces exterieures totalisees sur la base A.           *
  21. * e   NA1     Nombre total d'inconnues en base A.                    *
  22. * e   IPALA   Renseigne sur le type de la liaison.                   *
  23. * e   IPLIA   Tableau contenant les numeros "DYNE" de la liaison.    *
  24. * e   XPALA   Tableau contenant les parametres de la liaison.        *
  25. * es  XVALA   Tableau contenant les variables internes des liaisons  *
  26. * e   NLIAA   Nombre de liaisons sur la base A.                      *
  27. * e   PDT     pas de temps                                           *
  28. * e   T       temps                                                  *
  29. * e   NPAS    Numero du pas de temps                                 *
  30. * e   IND     Indice du demi-pas de temps                            *
  31. *             = 2 si 1er demi-pas  = 1 si 2eme demi-pas              *
  32. * es  FINERT  Forces d'inertie                                       *
  33. * e   IVINIT  =1 si vitesses initiales, =0 sinon                     *
  34. *                                                                    *
  35. *   remarque:                                                        *
  36. *   =========                                                        *
  37. *   Si jeu negatif (cas particulier de la base A ou il n'y a pas de  *
  38. *      normale), on renverse les variables avec XNORM.               *
  39. *                                                                    *
  40. *--------------------------------------------------------------------*
  41. *
  42.       INTEGER IPALA(NLIAA,*),IPLIA(NLIAA,*)
  43.       REAL*8  XPALA(NLIAA,*),Q1(NA1,*),Q2(NA1,*),FTOTA(NA1,*)
  44.       REAL*8  XVALA(NLIAA,4,*),FINERT(NA1,*)
  45.       PARAMETER (XZERO = 0.D0, XONE=1.D0)
  46.       REAL*8  FTest(nA1,4)
  47. cbp, supprime le 2020-08-07          REAL*8  FTOTA0(NA1,4)
  48.  
  49.       PDTS2 = 0.5D0 * PDT
  50.  
  51. *--------------------------------------------------------------------*
  52. *     BOUCLE SUR LES LIAISONS
  53. *--------------------------------------------------------------------*
  54.  
  55.       DO 10 I = 1,NLIAA
  56.  
  57.          ITYP = IPALA(I,1)
  58.          icond= IPALA(I,2)
  59.          iannul= 0
  60.  
  61.          IF (ICOND .NE. 1 ) GOTO 199
  62. *        CAS DES LIAISONS CONDITIONNELLES : 
  63. *>>>>>>> BOUCLE SUR LES LIAISONS "TESTS"     <<<<<<<<<<<<<<<<<<<<<<<<<<
  64.          DO 101 j = 4,20
  65.  
  66.            jliai = ipala(i,j)
  67.            jpliai = abs ( jliai)
  68.            if ( jliai . EQ. 0 ) goto 101
  69.  
  70.            jtyp = ipala(jpliai,1)
  71.            do 102 jk = 1,4
  72.            do 103 ik = 1,nA1
  73.                    ftest(ik,jk) = 0d0
  74. cbp, supprime le 2020-08-07    ftota0 (ik,jk) = ftota(ik,jk)
  75.  103       continue
  76.  102       continue
  77.  
  78. *      >>> CALCUL DES FORCES DES LIAISONS TEST <<<
  79. *
  80. * ------ choc elementaire POINT_PLAN sans amortissement
  81. *
  82.          IF (JTYP.EQ.1) THEN
  83.             XRAID = XPALA(jpliai,1)
  84.             XJEU  = XPALA(jpliai,2)
  85.             ETA = XZERO
  86.             XNORM = XONE
  87.             IF (XJEU.LT.0D0) THEN
  88.                 XNORM = -XONE
  89.                 XJEU = -XJEU
  90.             ENDIF
  91.             INA1 = IPLIA(jpliai,1)
  92.             XDEP = XNORM*Q1(INA1,IND)
  93.             CALL DYCHEL(XDEP,XRAID,XJEU,ETA,XFL,DFDX,iannul)
  94.             XVALA(jpliai,IND,1) = XNORM*XFL
  95.             XVALA(jpliai,IND,4) = XNORM*XDEP
  96.             FTest(INA1,IND) =Ftest(INA1,IND) + XNORM*XFL
  97. *
  98. * ------ choc elementaire POINT_PLAN avec amortissement
  99. *
  100.          ELSE IF (JTYP.EQ.2) THEN
  101.             XRAID = XPALA(jpliai,1)
  102.             XJEU = XPALA(jpliai,2)
  103.             XAMO = XPALA(jpliai,3)
  104.             ETA = XZERO
  105.             XNORM = XONE
  106.             IPERM = 0
  107.             IF (XJEU.LT.XZERO) THEN
  108.                 XNORM = -XONE
  109.                 XJEU = -XJEU
  110.             ENDIF
  111.             INA1 = IPLIA(jpliai,1)
  112.             XDEP = XNORM * Q1(INA1,IND)
  113. cbp,2020-09            IF ((NPAS.EQ.1).AND.(IND.EQ.3)) THEN
  114.                XVIT = XNORM * Q2(INA1,IND)
  115. cbp,2020-09            ELSE
  116. cbp,2020-09               IND2 = IND + 1
  117. cbp,2020-09               XDEPM1 =  XNORM * Q1(INA1,IND2)
  118. cbp,2020-09               XVIT = (XDEP - XDEPM1) / PDTS2
  119. cbp,2020-09            ENDIF
  120.             XVALA(jpliai,IND,3) = XNORM*XVIT
  121.             CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,ETA,
  122.      &                  XFL,DFDX,DFDV,IPERM,iannul)
  123. *           bp,2020 : pertinence des 2 lignes ci-dessous (cf. dycham) ? 
  124. *           -> a verifier + tard ...
  125. c             IF(ETA.EQ.0.)THEN
  126. c             IF (XDEP.GT.0.D0 .AND. XFL.GT.0.D0) XFL = 0.D0
  127. c             IF (XDEP.LT.0.D0 .AND. XFL.LT.0.D0) XFL = 0.D0
  128. c             ENDIF            
  129.             XVALA(jpliai,IND,1) = XNORM*XFL
  130.             XVALA(jpliai,IND,4) = XNORM*XDEP
  131.             FTest(INA1,IND) =Ftest(INA1,IND) + XNORM*XFL
  132. *
  133. * ------ choc elementaire POINT_PLAN_FLUIDE
  134. *
  135.          ELSE IF (JTYP.EQ.3) THEN
  136.             XINER = XPALA(jpliai,1)
  137.             XCONV = XPALA(jpliai,2)
  138.             XVISC = XPALA(jpliai,3)
  139.             XPCEL = XPALA(jpliai,4)
  140.             XPCRA = XPALA(jpliai,5)
  141.             XJEU = XPALA(jpliai,6)
  142.             INA1 = IPLIA(jpliai,1)
  143.             XDEP = Q1(INA1,IND)
  144. cbp,2020-09               IF ((NPAS.EQ.1).AND.(IND.EQ.3)) THEN
  145.                   XVIT = Q2(INA1,IND)
  146. cbp,2020-09                  ELSE
  147. cbp,2020-09               IND2 = IND + 1
  148. cbp,2020-09               XDEPM1 = Q1(INA1,IND2)
  149. cbp,2020-09               XVIT = (XDEP - XDEPM1) / PDTS2
  150. cbp,2020-09                    ENDIF
  151.             IF (XJEU.GT.0D0) THEN
  152.                XDH= XJEU - XDEP
  153.                XNORM = XONE
  154.             ELSE
  155.                XDH= XDEP - XJEU
  156.                XNORM = -XONE
  157.             ENDIF
  158. *   Calcul de la masse ajoutee
  159.             XXIN = -XINER / XDH
  160.             FINERT(INA1,IND) = FINERT(INA1,IND) + XXIN
  161. *   Calcul de la force de convection
  162.             CALL DYFCON(XDH,XDEP,XVIT,XJEU,XCONV,XFCO,iannul)
  163. *   Calcul de la force de viscosite
  164.             CALL DYFVIS(XDH,XDEP,XVIT,XJEU,XVISC,XFVI,iannul)
  165. *   Calcul de la force de perte de charge
  166.             CALL DYFPDC(XDH,XDEP,XVIT,XJEU,XPCEL,XPCRA,XFPE,iannul)
  167.             XFL = (XFCO* XNORM )  + XFVI + XFPE
  168.             XVALA(jpliai,IND,1) = XDEP
  169.             XVALA(jpliai,IND,2) = XVIT
  170.             XVALA(jpliai,IND,3) = XXIN
  171.             XVALA(jpliai,IND,4) = XFCO*XNORM
  172.             XVALA(jpliai,IND,5) = XFVI
  173.             XVALA(jpliai,IND,6) = XFPE
  174.             FTest(INA1,IND) =Ftest(iNA1,IND) + XFL
  175. *
  176. * ------ force elementaire de COUPLAGE EN VITESSE
  177. *
  178.          ELSE IF (JTYP.EQ.4) THEN
  179.             INA1 = IPLIA(jpliai,1)
  180.             INA2 = IPLIA(jpliai,2)
  181.             XDEP = Q1(INA2,IND)
  182. cbp,2020-09            IF ((NPAS.EQ.1).AND.(IND.EQ.3)) THEN
  183.                XVIT = Q2(INA2,IND)
  184. cbp,2020-09            ELSE
  185. cbp,2020-09               IND2 = IND + 1
  186. cbp,2020-09               XDEPM1 = Q1(INA2,IND2)
  187. cbp,2020-09               XVIT = (XDEP - XDEPM1) / PDTS2
  188. cbp,2020-09            ENDIF
  189.             XCPLGE = XPALA(jpliai,1)
  190.             CALL DYCPLV(XVIT,XCPLGE,XFL,iannul)
  191.             XVALA(jpliai,IND,3) = XVIT
  192.             XVALA(jpliai,IND,1) = XFL
  193.             XVALA(jpliai,IND,4) = XDEP
  194.             FTest(INA1,IND) =Ftest(INA1,IND) + XFL
  195. *
  196. * ------ force elementaire de COUPLAGE EN DEPLACEMENT
  197. *
  198.          ELSE IF (JTYP.EQ.5) THEN
  199.             INA1 = IPLIA(jpliai,1)
  200.             INA2 = IPLIA(jpliai,2)
  201.             XDEP = Q1(INA2,IND)
  202.             XCPLGE = XPALA(jpliai,1)
  203.             jfonct = ipala(jpliai,3)
  204.  
  205. cbp       - calcul eventuel d'un produit de convolution :
  206. c           XDEP=\int_0^T h(\tau)*Qj(t-\tau) d\tau
  207.             if(jfonct.eq.100) then
  208.                IP1=IPALA(jpliai,4)
  209. c              t_{n+1} ou t_{n}
  210.                if (IND.eq.1.or.IND.eq.3) then 
  211.                  IP2=IPALA(jpliai,5)
  212. c              t_{n+1/2} ou t_{n-1/2}
  213.                else
  214.                  IP2=IPALA(jpliai,6)
  215.                endif
  216.                CALL DYCPL1(IP1,IP2,XDEP,NPAS,PDT,XCONV)
  217.                XFL=XCPLGE*XCONV
  218.  
  219. cbp       - calcul d'un produit de convolution GRANGER_PAIDOUSSIS
  220.             elseif(jfonct.eq.101) then
  221.                IP1=IPALA(jpliai,4)
  222.                IP2=IPALA(jpliai,5)
  223.                IP3=IPALA(jpliai,6)
  224.                VSD=XPALA(jpliai,2)
  225.                XA0=XPALA(jpliai,3)
  226.                CALL DYCPL2(IP1,IP2,IP3,VSD,XA0,XDEP,NPAS,PDTS2,XCONV)
  227.                XFL=XCPLGE*XCONV               
  228.  
  229. cbp       - calcul du produit par une fonction trigo cos(q)
  230. c           rem : on pourrait aussi prevoir cos(coef2*q) avec coef2=XPALA(jpliai,2)
  231.             elseif(jfonct.eq.1) then
  232.                 XFL = XCPLGE * COS(XDEP)
  233.             elseif(jfonct.eq.2) then
  234.                 XFL = XCPLGE * SIN(XDEP)  
  235.  
  236. cbp       - calcul du produit par une fonction temporelle cos(wt)*q
  237.             elseif(jfonct.ge.11.and.jfonct.le.12) then
  238.                 XFREQ  = XPALA(jpliai,2)
  239.                 XTIME = DBLE(NPAS-1)*PDT
  240.                 if(IND.EQ.2) XTIME=XTIME-PDTS2
  241.                 if(jfonct.eq.1) XFONCT = COS(XFREQ*XTIME)
  242.                 if(jfonct.eq.2) XFONCT = SIN(XFREQ*XTIME)
  243.                 XFL = XCPLGE * XDEP * XFONCT
  244.  
  245. c         - simple raideur (ou raideur en puissance)
  246.             else
  247.                   Xexpo = XPALA(jpliai,2)
  248.                   if(Xexpo.eq.XONE) then
  249.                     XFL = XCPLGE * XDEP
  250.                   else
  251.                     XFL = XCPLGE * (XDEP**Xexpo)
  252.                   endif
  253.             endif
  254. cbp, ici    prise en compte de la possibilite de liaison conditionnelle 
  255.             IF(iannul.ne.0) XFL=XZERO           
  256.             XVALA(jpliai,IND,1) = XFL
  257.             XVALA(jpliai,IND,4) = XDEP
  258.             FTest(INA1,IND) =Ftest(INA1,IND) + XFL
  259. *
  260. * ------ force elementaire de type POLYNOMIALE
  261. *
  262.          ELSE IF (JTYP.EQ.6) THEN
  263. *           nombre de modes "origine"
  264.             NMOD = IPALA(I,2)
  265.             CALL DYPOL1(Q1,Q2,NA1,IPLIA,XPALA,XVALA,NLIAA,IND,PDT,
  266.      &                  NPAS,jpliai,NMOD,FTest,IVINIT,iannul)
  267. *
  268. * ------ choc elementaire ...
  269. *
  270. *        ELSE IF (JTYP.EQ.  ) THEN
  271. *              .......
  272. *              .......
  273. *
  274.          ENDIF
  275.  
  276.  
  277. *       >>> TEST SUR j POUR VOIR SI ELLE ANNULE LA LIAISON I <<<
  278.  
  279.            xff = 0d0
  280.            do 104 ik = 1,na1
  281.               do 105 jk = 1,4
  282.                    xff = xff + ( ftest(ik,jk) ** 2)
  283.  105          continue
  284.  104       continue
  285.            xff = xff ** .5
  286.            if (   ((xff .le. 1e-20 ) .and. ( jliai .gt. 0) )
  287.      &       .OR. ((xff .gt. 1e-20 ) .and. ( jliai .lt. 0) )  )
  288.      &        then
  289.               iannul = 1
  290.            endif
  291.  
  292.  
  293.  101     CONTINUE
  294. *>>>>>>> FIN DE BOUCLE SUR LES LIAISONS "TESTS"     <<<<<<<<<<<<<<<<<<<<
  295.  
  296.  
  297.  199     CONTINUE
  298. *>>>>>>> CALCUL DES FORCES DE LIAISONS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  299.  
  300.  
  301. * ------ choc elementaire POINT_PLAN sans amortissement
  302. *
  303.          IF (ITYP.EQ.1) THEN
  304.             XRAID = XPALA(I,1)
  305.             XJEU = XPALA(I,2)
  306.             ETA = XZERO
  307.             XNORM = XONE
  308.             IF (XJEU.LT.0D0) THEN
  309.                 XNORM = -XONE
  310.                 XJEU = -XJEU
  311.             ENDIF
  312.             INA1 = IPLIA(I,1)
  313.             XDEP = XNORM*Q1(INA1,IND)
  314.             CALL DYCHEL(XDEP,XRAID,XJEU,ETA,XFL,DFDX,iannul)
  315.             XVALA(I,IND,1) = XNORM*XFL
  316.             XVALA(I,IND,4) = XNORM*XDEP
  317.             FTOTA(INA1,IND) = FTOTA(INA1,IND) + XNORM*XFL
  318.  
  319. *
  320. * ------ choc elementaire POINT_PLAN avec amortissement
  321. *
  322.          ELSE IF (ITYP.EQ.2) THEN
  323.             XRAID = XPALA(I,1)
  324.             XJEU = XPALA(I,2)
  325.             XAMO = XPALA(I,3)
  326.             XNORM = XONE
  327.             IPERM = 0
  328.             IF (XJEU.LT.XZERO) THEN
  329.                 XNORM = -XONE
  330.                 XJEU = -XJEU
  331.             ENDIF
  332.             INA1 = IPLIA(I,1)
  333.             XDEP = XNORM * Q1(INA1,IND)
  334. cbp,2020-09            IF ((NPAS.EQ.1).AND.(IND.EQ.3)) THEN
  335.                XVIT = XNORM * Q2(INA1,IND)
  336. cbp,2020-09            ELSE
  337. cbp,2020-09               IND2 = IND + 1
  338. cbp,2020-09               XDEPM1 =  XNORM * Q1(INA1,IND2)
  339. cbp,2020-09               XVIT = (XDEP - XDEPM1) / PDTS2
  340. cbp,2020-09                  ENDIF
  341.             XVALA(I,IND,3) = XNORM*XVIT
  342.             CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,ETA,
  343.      &                  XFL,DFDX,DFDV,IPERM,iannul)
  344. *           bp,2020 : pertinence des 2 lignes ci-dessous (cf. dycham) ? 
  345. *           -> on commente... a verifier + tard
  346. *            IF (XDEP.GT.0.D0 .AND. XFL.GT.0.D0) XFL = 0.D0
  347. *            IF (XDEP.LT.0.D0 .AND. XFL.LT.0.D0) XFL = 0.D0
  348.             XVALA(I,IND,1) = XNORM*XFL
  349.             XVALA(I,IND,4) = XNORM*XDEP
  350.             FTOTA(INA1,IND) = FTOTA(INA1,IND) + XNORM*XFL
  351.  
  352. *
  353. * ------ choc elementaire POINT_PLAN_FLUIDE
  354. *
  355.          ELSE IF (ITYP.EQ.3) THEN
  356.             XINER = XPALA(I,1)
  357.             XCONV = XPALA(I,2)
  358.             XVISC = XPALA(I,3)
  359.             XPCEL = XPALA(I,4)
  360.             XPCRA = XPALA(I,5)
  361.             XJEU = XPALA(I,6)
  362.             INA1 = IPLIA(I,1)
  363.             XDEP = Q1(INA1,IND)
  364. *
  365.             IF ((NPAS.EQ.1).AND.(IND.EQ.3)) THEN
  366.                XVIT = Q2(INA1,IND)
  367.             ELSE
  368.                IND2 = IND + 1
  369.                XDEPM1 = Q1(INA1,IND2)
  370.                XVIT = (XDEP - XDEPM1) / PDTS2
  371.             ENDIF
  372.             IF (XJEU.GT.0D0) THEN
  373.                XDH= XJEU - XDEP
  374.                XNORM = XONE
  375.             ELSE
  376.                XDH= XDEP - XJEU
  377.                XNORM = -XONE
  378.             ENDIF
  379. *   Calcul de la masse ajoutee
  380.             XXIN = -XINER / XDH
  381.             FINERT(INA1,IND) = FINERT(INA1,IND) + XXIN
  382. *   Calcul de la force de convection
  383.             CALL DYFCON(XDH,XDEP,XVIT,XJEU,XCONV,XFCO,iannul)
  384. *   Calcul de la force de viscosite
  385.             CALL DYFVIS(XDH,XDEP,XVIT,XJEU,XVISC,XFVI,iannul)
  386. *   Calcul de la force de perte de charge
  387.             CALL DYFPDC(XDH,XDEP,XVIT,XJEU,XPCEL,XPCRA,XFPE,
  388.      &                                  iannul)
  389.             XFL = (XFCO* XNORM )  + XFVI + XFPE
  390.             XVALA(I,IND,1) = XDEP
  391.             XVALA(I,IND,2) = XVIT
  392.             XVALA(I,IND,3) = XXIN
  393.             XVALA(I,IND,4) = XFCO*XNORM
  394.             XVALA(I,IND,5) = XFVI
  395.             XVALA(I,IND,6) = XFPE
  396.             FTOTA(INA1,IND) = FTOTA(INA1,IND) + XFL
  397.  
  398. *
  399. * ------ force elementaire de COUPLAGE EN VITESSE
  400. *
  401.          ELSE IF (ITYP.EQ.4) THEN
  402.             INA1 = IPLIA(I,1)
  403.             INA2 = IPLIA(I,2)
  404.             XDEP = Q1(INA2,IND)
  405. cbp,2020-09            IF ((NPAS.EQ.1).AND.(IND.EQ.3)) THEN
  406.                XVIT = Q2(INA2,IND)
  407. cbp,2020-09            ELSE
  408. cbp,2020-09               IND2 = IND + 1
  409. cbp,2020-09               XDEPM1 = Q1(INA2,IND2)
  410. cbp,2020-09               XVIT = (XDEP - XDEPM1) / PDTS2
  411. cbp,2020-09            ENDIF
  412.             XCPLGE = XPALA(I,1)
  413.             CALL DYCPLV(XVIT,XCPLGE,XFL,iannul)
  414. c             WRITE(*,*) 't=',(NPAS*PDT),'dx/dt=',XVIT,'F2=',XFL
  415.             XVALA(I,IND,3) = XVIT
  416.             XVALA(I,IND,1) = XFL
  417.             XVALA(I,IND,4) = XDEP
  418.             FTOTA(INA1,IND) = FTOTA(INA1,IND) + XFL
  419.  
  420. *
  421. * ------ force elementaire de COUPLAGE EN DEPLACEMENT
  422. *
  423.          ELSE IF (ITYP.EQ.5) THEN
  424.             INA1 = IPLIA(I,1)
  425.             INA2 = IPLIA(I,2)
  426.             XDEP = Q1(INA2,IND)
  427.             XCPLGE = XPALA(I,1)
  428.             jfonct = ipala(I,3)
  429.  
  430. cbp       - calcul eventuel d'un produit de convolution :
  431. c           XDEP=\int_0^T h(\tau)*Qj(t-\tau) d\tau
  432.             if(jfonct.eq.100) then
  433.                IP1=IPALA(I,4)
  434. c              t_{n+1} ou t_{n}
  435.                if (IND.eq.1.or.IND.eq.3) then 
  436.                  IP2=IPALA(I,5)
  437. c              t_{n+1/2} ou t_{n-1/2}
  438.                else
  439.                  IP2=IPALA(I,6)
  440.                endif
  441.                CALL DYCPL1(IP1,IP2,XDEP,NPAS,PDT,XCONV)
  442.                XFL=XCPLGE*XCONV
  443.  
  444. cbp       - calcul d'un produit de convolution GRANGER_PAIDOUSSIS
  445.             elseif(jfonct.eq.101) then
  446.                IP1=IPALA(I,4)
  447.                IP2=IPALA(I,5)
  448.                IP3=IPALA(I,6)
  449.                VSD=XPALA(I,2)
  450.                XA0=XPALA(I,3)
  451.                CALL DYCPL2(IP1,IP2,IP3,VSD,XA0,XDEP,NPAS,PDTS2,XCONV)
  452.                XFL=XCPLGE*XCONV               
  453.  
  454. cbp       - calcul du produit par une fonction trigo cos(q)
  455. c           rem : on pourrait aussi prevoir cos(coef2*q) avec coef2=XPALA(I,2)
  456.             elseif(jfonct.eq.1) then
  457.                 XFL = XCPLGE * COS(XDEP)
  458.             elseif(jfonct.eq.2) then
  459.                 XFL = XCPLGE * SIN(XDEP)  
  460.  
  461. cbp       - calcul du produit par une fonction temporelle cos(wt)*q
  462.             elseif(jfonct.ge.11.and.jfonct.le.12) then
  463.                 XFREQ  = XPALA(I,2)
  464.                 XTIME = DBLE(NPAS-1)*PDT
  465.                 if(IND.EQ.2) XTIME=XTIME-PDTS2
  466.                 if(jfonct.eq.1) XFONCT = COS(XFREQ*XTIME)
  467.                 if(jfonct.eq.2) XFONCT = SIN(XFREQ*XTIME)
  468.                 XFL = XCPLGE * XDEP * XFONCT
  469.  
  470. c         - simple raideur (ou raideur en puissance)
  471.             else
  472.                   Xexpo = XPALA(I,2)
  473.                   if(Xexpo.eq.XONE) then
  474.                     XFL = XCPLGE * XDEP
  475.                   else
  476.                     XFL = XCPLGE * (XDEP**Xexpo)
  477.                   endif
  478.             endif
  479. cbp, ici    prise en compte de la possibilite de liaison conditionnelle 
  480.             IF(iannul.ne.0) XFL=XZERO
  481.             XVALA(I,IND,1) = XFL
  482.             XVALA(I,IND,4) = XDEP
  483.             FTOTA(INA1,IND) = FTOTA(INA1,IND) + XFL
  484.  
  485. *
  486. * ------ force elementaire de type POLYNOMIALE
  487. *
  488.          ELSE IF (ITYP.EQ.6) THEN
  489. *           nombre de modes "origine"
  490.             NMOD = IPALA(I,2)
  491.             CALL DYPOL1(Q1,Q2,NA1,IPLIA,XPALA,XVALA,NLIAA,IND,PDT,
  492.      &                  NPAS,I,NMOD,FTOTA,IVINIT,iannul)
  493. *
  494. * ------ choc elementaire ...
  495. *
  496. *        ELSE IF (ITYP.EQ.  ) THEN
  497. *              .......
  498. *              .......
  499. *
  500.          ENDIF
  501.  
  502. *
  503. * la suite n'est plus utile car on passe iannul aux s_p de calcul des
  504. * forces de liaisons.
  505. *       si la liaison etait annulee on l'annule
  506. *         if ( ( icond.eq. 1 ) .and. ( iannul.eq.1)) then
  507. *              on annule l'increment de ftotb
  508. *                do 112 ik = 1,na1
  509. *                  do 113 jk = 1,4
  510. *                        ftota (ik,jk) = ftota0(ik,jk)
  511. * 113              continue
  512. * 112            continue
  513. *         end if
  514.  
  515.   10  CONTINUE
  516. *--------------------------------------------------------------------*
  517. *     FIN DE BOUCLE SUR LES LIAISONS
  518. *--------------------------------------------------------------------*
  519. *
  520.       END
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  

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