Télécharger la plaquette Cast3M


fr en

Télécharger cosi.eso

Retour à la liste

Numérotation des lignes : 

cosi

  1. C COSI      SOURCE    CHAT      05/01/12    22:22:50     5004
  2. *$$$$ COSI
  3. C     COSI      SOURCE    ISPRA      90/06/12
  4.       SUBROUTINE COSI
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT  REAL*8(A-H,O-Z)
  7. C=======================================================================
  8. C    OPERATEUR COSI
  9. C
  10. C    A2*EVOLUTION = COSI A1*EVOLUTION (METH*MOT)
  11. C
  12. C=======================================================================
  13. C    PROGRAMMEUR : P.P.
  14. C=======================================================================
  15. C
  16.       CHARACTER *72 TI
  17.       CHARACTER*12 MOTX,MOTY
  18. C
  19.       PARAMETER (NMOCLE=2)
  20.       CHARACTER*4 MOTCLE(NMOCLE)
  21. C
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMEVOLL
  26. -INC SMLREEL
  27. C
  28.       POINTEUR IACCE1.MLREEL,ITEMP1.MLREEL,IACCE2.MLREEL,ITEMP2.MLREEL
  29.       POINTEUR JACCE1.MEVOLL,JACCE2.MEVOLL
  30.       POINTEUR KACCE1.KEVOLL,KACCE2.KEVOLL
  31.       SEGMENT, MTRAV
  32.           IMPLIED AI(NPT),BI(NPT),GI(NPT)
  33.       ENDSEGMENT
  34. C
  35.       DIMENSION A(3,3),B(3)
  36. C
  37. C     1) LECTURE DES DONNEES GIBIANE
  38. C
  39. C     1.1) LISTE DES MOTS CLEF
  40. C
  41.       DATA MOTCLE/'SIMP','LINE'/
  42. C
  43. C
  44. C     1.2) DEFAUTS
  45. C
  46.       IMETH=1
  47. C
  48. C     1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT L'ACCELERATION
  49. C
  50.       CALL LIROBJ('EVOLUTIO',JACCE1,1,IRET)
  51.       IF(IRET.EQ.0) GOTO 666
  52. C
  53. C     1.4) LECTURE DU MOT-CLEF
  54. C          (OPTIONEL)
  55. C
  56.       CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  57. C
  58.       IF(IVAL.NE.0)THEN
  59.         IMETH=IVAL
  60.       ENDIF
  61. C
  62. C
  63. C     2) VERIFICATION DES DONNEES
  64. C
  65. C     2.1) MEME ABSCISSE
  66. C
  67.       SEGACT, JACCE1
  68.       N=JACCE1.IEVOLL(/1)
  69.       DO 10 IE1=1,N
  70.         KACCE1=JACCE1.IEVOLL(IE1)
  71.         SEGACT, KACCE1
  72.         ITEMP=KACCE1.IPROGX
  73.         SEGDES, KACCE1
  74.         IF(IE1.EQ.1)THEN
  75.           ITEMP1=ITEMP
  76.         ELSE
  77.           IF(ITEMP.NE.ITEMP1)THEN
  78.             CALL ERREUR(567)
  79.             SEGDES, JACCE1
  80.             GOTO 666
  81.           ENDIF
  82.         ENDIF
  83.  10   CONTINUE
  84. C
  85. C     2.2) REPARTITION HOMOGENE DES DT
  86. C
  87.       SEGACT, ITEMP1
  88.       NPT=ITEMP1.PROG(/1)
  89.       DT=(ITEMP1.PROG(NPT)-ITEMP1.PROG(1))/(NPT-1)
  90.       DT1=ITEMP1.PROG(2)-ITEMP1.PROG(1)
  91.       SEGDES,  ITEMP1
  92.       IF(ABS(DT1-DT)/DT.GT.1.D-5)THEN
  93.         CALL ERREUR(568)
  94.         SEGDES, JACCE1
  95.         GOTO 666
  96.       ENDIF
  97. C
  98. C     3) DUPLICATION DES TEMPS ET INITIALISATIONS DIVERSES
  99. C
  100.       SEGINI, ITEMP2=ITEMP1
  101.       SEGDES, ITEMP2
  102. C
  103.       TI=JACCE1.IEVTEX
  104.       SEGINI, JACCE2
  105.       JACCE2.IEVTEX='Correction de:'//TI(1:58)
  106. C
  107.       SEGINI, MTRAV
  108. C
  109. C
  110. C     4) LOOP DE CALCUL
  111. C
  112.       DO 100 IE1=1,N
  113. C
  114. C     4.1) INITIALISATION ET DUPLICATION DES DONNEES
  115. C
  116. C
  117.         KACCE1=JACCE1.IEVOLL(IE1)
  118.         SEGINI, KACCE2=KACCE1
  119. C
  120.         KACCE2.IPROGX=ITEMP2
  121. C
  122.         IACCE1=KACCE2.IPROGY
  123.         SEGINI, IACCE2=IACCE1
  124.         KACCE2.IPROGY=IACCE2
  125. C
  126.         SEGDES, KACCE2
  127.         JACCE2.IEVOLL(IE1)=KACCE2
  128. C
  129. C
  130. C     4.2) CALCUL DE ALPHA(I), BETA(I) ET GAMMA(I)
  131. C
  132. C     4.2.1) METHODE SIMPLIFIEE
  133. C
  134.         IF(IMETH.EQ.1)THEN
  135.           AI(1)=DT/2
  136.           BI(1)=(2*(NPT-2)+1)*DT*DT/4
  137.           DO 20 IE2=2,NPT-1
  138.             AI(IE2)=DT
  139.             BI(IE2)=(NPT-IE2)*DT*DT
  140.  20         CONTINUE
  141.           AI(NPT)=DT/2
  142.           BI(NPT)=DT*DT/4
  143. C
  144.           GI(1)=0.D0
  145.           DO 21 IE2=2,NPT
  146.             GI(1)=GI(1)+BI(IE2)*DT/2
  147.  21       CONTINUE
  148.           DO 22 IE2=2,NPT-1
  149.             GI(IE2)=BI(IE2)*DT/2
  150.             DO 22 IE3=IE2+1,NPT
  151.               GI(IE2)=GI(IE2)+BI(IE3)*DT
  152.  22       CONTINUE
  153.           GI(NPT)=BI(NPT)*DT/2
  154.         ENDIF
  155. C
  156. C     4.2.2) METHODE LINEAIRE
  157. C
  158.         IF(IMETH.EQ.2)THEN
  159.           AI(1)=DT/2
  160.           BI(1)=(3*(NPT-2)+2)*DT*DT/6
  161.           DO 25 IE2=2,NPT-1
  162.             AI(IE2)=DT
  163.             BI(IE2)=(NPT-IE2)*DT*DT
  164.  25         CONTINUE
  165.           AI(NPT)=DT/2
  166.           BI(NPT)=DT*DT/6
  167. C
  168.           GI(1)=(2*(NPT-2)+1)*DT*DT*DT/24
  169.           DO 26 IE2=2,NPT
  170.             GI(1)=GI(1)+BI(IE2)*DT/2
  171.  26       CONTINUE
  172.           DO 27 IE2=2,NPT-1
  173.             GI(IE2)=BI(IE2)*DT/2-DT*DT*DT/12
  174.             DO 27 IE3=IE2+1,NPT
  175.               GI(IE2)=GI(IE2)+BI(IE3)*DT
  176.  27       CONTINUE
  177.           GI(NPT)=BI(NPT)*DT/4
  178.         ENDIF
  179. C
  180. C     4.3) CALCUL DE A ET B
  181. C
  182.         DO 30 IE2=1,3
  183.           B(IE2)=0.D0
  184.           DO 30 IE3=1,3
  185.             A(IE3,IE2)=0.D0
  186.  30     CONTINUE
  187.         DO 31 IE2=1,NPT
  188.           A(1,1)=A(1,1)+AI(IE2)**2
  189.           A(1,2)=A(1,2)+AI(IE2)*BI(IE2)
  190.           A(1,3)=A(1,3)+AI(IE2)*GI(IE2)
  191.           A(2,2)=A(2,2)+BI(IE2)**2
  192.           A(2,3)=A(2,3)+BI(IE2)*GI(IE2)
  193.           A(3,3)=A(3,3)+GI(IE2)**2
  194.           B(1)=B(1)+AI(IE2)*IACCE2.PROG(IE2)
  195.           B(2)=B(2)+BI(IE2)*IACCE2.PROG(IE2)
  196.           B(3)=B(3)+GI(IE2)*IACCE2.PROG(IE2)
  197.  31     CONTINUE
  198.         A(2,1)=A(1,2)
  199.         A(3,1)=A(1,3)
  200.         A(3,2)=A(2,3)
  201. C
  202. C     4.4) RESOLUTION DE A*X=B
  203. C
  204.         DET=A(1,1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3))
  205.      >     -A(2,1)*(A(1,2)*A(3,3)-A(3,2)*A(1,3))
  206.      >     +A(3,1)*(A(1,2)*A(2,3)-A(2,2)*A(1,3))
  207.         XAM1= B(1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3))
  208.      >       -B(2)*(A(1,2)*A(3,3)-A(3,2)*A(1,3))
  209.      >       +B(3)*(A(1,2)*A(2,3)-A(2,2)*A(1,3))
  210.         XAM2=-B(1)*(A(2,1)*A(3,3)-A(3,1)*A(2,3))
  211.      >       +B(2)*(A(1,1)*A(3,3)-A(3,1)*A(1,3))
  212.      >       -B(3)*(A(1,1)*A(2,3)-A(2,1)*A(1,3))
  213.         XAM3= B(1)*(A(2,1)*A(3,2)-A(3,1)*A(2,2))
  214.      >       -B(2)*(A(1,1)*A(3,2)-A(3,1)*A(1,2))
  215.      >       +B(3)*(A(1,1)*A(2,2)-A(2,1)*A(1,2))
  216.         XAM1=XAM1/DET
  217.         XAM2=XAM2/DET
  218.         XAM3=XAM3/DET
  219. C
  220. C     4.5) CORRECTION DE L'ACCELERATION
  221. C
  222.         DO 40 IE2=1,NPT
  223.           IACCE2.PROG(IE2)=IACCE2.PROG(IE2)
  224.      >    -XAM1*AI(IE2)-XAM2*BI(IE2)-XAM3*GI(IE2)
  225.  40       CONTINUE
  226. C
  227. C     4.6) FIN ACTIVATION
  228. C
  229.         SEGDES, IACCE2
  230. C
  231.  100    CONTINUE
  232. C
  233. C
  234. C
  235.       SEGSUP, MTRAV
  236.       SEGDES, JACCE1
  237.       SEGDES, JACCE2
  238. C
  239. C     5) RETOUR A GIBIANE
  240. C
  241.       CALL ECROBJ('EVOLUTIO',JACCE2)
  242. C
  243. C
  244.  666  CONTINUE
  245.       RETURN
  246.       END
  247.  
  248.  
  249.  
  250.  
  251.  

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