Download insi.eso

Back to the list

   1 : C INSI      SOURCE    CHAT      05/01/13    00:39:12     5004           
   2 : C$$$$ INSI
   3 : C     INSI      SOURCE    ISPRA      90/06/12
   4 :       SUBROUTINE INSI
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT  REAL*8(A-H,O-Z)
   7 : C=======================================================================
   8 : C    OPERATEUR INSI
   9 : C
  10 : C    D*EVOLUTION V*EVOLUTION = INSI A*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 : -INC CCOPTIO
  23 : -INC SMEVOLL
  24 : -INC SMLREEL
  25 : C
  26 :       POINTEUR IACCE.MLREEL,IVITE.MLREEL,IDEPL.MLREEL,ITEMP.MLREEL
  27 :       POINTEUR JACCE.MEVOLL,JVITE.MEVOLL,JDEPL.MEVOLL
  28 :       POINTEUR KACCE.KEVOLL,KVITE.KEVOLL,KDEPL.KEVOLL
  29 : C
  30 : C     1) LECTURE DES DONNEES GIBIANE
  31 : C
  32 : C     1.1) LISTE DES MOTS CLEF
  33 : C
  34 :       DATA MOTCLE/'SIMP','LINE'/
  35 : C
  36 : C     1.2) DEFAUTS
  37 : C
  38 :       IMETH=1
  39 : C
  40 : C     1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT L'ACCELERATION
  41 : C
  41 :       CALL LIROBJ('EVOLUTIO',JACCE,1,IRET)
  42 :       IF(IRET.EQ.0) RETURN
  43 : C
  44 : C     1.4) LECTURE DU MOT-CLEF
  45 : C          (OPTIONEL)
  46 : C
  46 :       CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  47 : C
  48 :       IF(IVAL.NE.0)THEN
  49 :         IMETH=IVAL
  50 :       ENDIF
  51 : C
  52 : C
  53 : C     2) INITIALISATION DIVERSES
  54 : C
  55 :       SEGACT, JACCE
  56 :       N=JACCE.IEVOLL(/1)
  57 : C
  58 :       TI=JACCE.IEVTEX
  59 :       SEGINI, JVITE
  60 :       SEGINI, JDEPL
  61 :       JVITE.IEVTEX='Integration ('//MOTCLE(IMETH)//') de:'//TI(1:50)
  62 :       JDEPL.IEVTEX='Integration ('//MOTCLE(IMETH)//') de:'//TI(1:50)
  63 : C
  64 : C     3) LOOP DE CALCUL
  65 : C
  66 :       DO 100 IE1=1,N
  67 : C
  68 : C     3.1) INITIALISATION ET ACTIVATION
  69 : C
  70 :         KACCE=JACCE.IEVOLL(IE1)
  71 :         SEGACT, KACCE
  72 : C
  73 :         ITEMP=KACCE.IPROGX
  74 :         IACCE=KACCE.IPROGY
  75 :         ICOUL=KACCE.NUMEVX
  76 :         SEGDES, KACCE
  77 : C
  78 :         SEGACT, IACCE
  79 :         SEGACT, ITEMP
  80 :         NPT=ITEMP.PROG(/1)
  81 :         JG=NPT
  82 : C
  83 :         SEGINI, KVITE
  84 :         JVITE.IEVOLL(IE1)=KVITE
  85 : C
  86 :         WRITE(TI,'(A17,1X,A6,1X,I2)')'Signal en vitesse',
  87 :      >             'numero',IE1
  88 :         WRITE(MOTY,'(9HVitesse  ,1X,I2)')IE1
  89 :         SEGINI, IVITE
  90 : C
  91 :         KVITE.KEVTEX=TI
  92 :         KVITE.NUMEVX=ICOUL
  93 :         KVITE.NUMEVY='REEL'
  94 :         KVITE.TYPX='LISTREEL'
  95 :         KVITE.IPROGX=ITEMP
  96 :         KVITE.TYPY='LISTREEL'
  97 :         KVITE.IPROGY=IVITE
  98 :         KVITE.NOMEVY=MOTY(1:12)
  99 :         SEGDES, KVITE
 100 : C
 101 :         SEGINI, KDEPL
 102 :         JDEPL.IEVOLL(IE1)=KDEPL
 103 : C
 104 :         WRITE(TI,'(A21,1X,A6,1X,I2)')'Signal en deplacement',
 105 :      >           'numero',IE1
 106 :         WRITE(MOTY,'(9HDeplacem.,1X,I2)')IE1
 107 :         SEGINI, IDEPL
 108 : C
 109 :         KDEPL.KEVTEX=TI
 110 :         KDEPL.NUMEVX=ICOUL
 111 :         KDEPL.NUMEVY='REEL'
 112 :         KDEPL.TYPX='LISTREEL'
 113 :         KDEPL.IPROGX=ITEMP
 114 :         KDEPL.TYPY='LISTREEL'
 115 :         KDEPL.IPROGY=IDEPL
 116 :         KDEPL.NOMEVY=MOTY(1:12)
 117 :         SEGDES, KDEPL
 118 : C
 119 : C     3.2) CALCUL DE V(I) ET D(I)
 120 : C
 121 : C     3.2.1) METHODE SIMPLIFIEE
 122 : C
 123 :         IF(IMETH.EQ.1)THEN
 124 :           IVITE.PROG(1)=0.D0
 125 :           IDEPL.PROG(1)=0.D0
 126 :           DO 20 IE2=2,NPT
 127 :             DT=ITEMP.PROG(IE2)-ITEMP.PROG(IE2-1)
 128 :             IVITE.PROG(IE2)=IVITE.PROG(IE2-1)
 129 :      >      +DT*(IACCE.PROG(IE2-1)+IACCE.PROG(IE2))/2
 130 :             IDEPL.PROG(IE2)=IDEPL.PROG(IE2-1)
 131 :      >      +DT*(IVITE.PROG(IE2-1)+IVITE.PROG(IE2))/2
 132 :  20         CONTINUE
 133 :         ENDIF
 134 : C
 135 : C     3.2.2) METHODE LINEAIRE
 136 : C
 137 :         IF(IMETH.EQ.2)THEN
 138 :           IVITE.PROG(1)=0.D0
 139 :           IDEPL.PROG(1)=0.D0
 140 :           DO 25 IE2=2,NPT
 141 :             DT=ITEMP.PROG(IE2)-ITEMP.PROG(IE2-1)
 142 :             IVITE.PROG(IE2)=IVITE.PROG(IE2-1)
 143 :      >      +DT*(IACCE.PROG(IE2-1)+IACCE.PROG(IE2))/2
 144 :             IDEPL.PROG(IE2)=IDEPL.PROG(IE2-1)
 145 :      >      +DT*(IVITE.PROG(IE2-1)
 146 :      >           +DT*(IACCE.PROG(IE2)+2*IACCE.PROG(IE2-1))/6)
 147 :  25         CONTINUE
 148 :         ENDIF
 149 : C
 150 : C     3.3) FIN ACTIVATION
 151 : C
 152 :         SEGDES, IACCE
 153 :         SEGDES, ITEMP
 154 :         SEGDES, IVITE
 155 :         SEGDES, IDEPL
 156 : C
 157 :  100    CONTINUE
 158 : C
 159 : C
 160 : C
 161 :       SEGDES, JACCE
 162 :       SEGDES, JVITE
 163 :       SEGDES, JDEPL
 164 : C
 165 : C     4) RETOUR A GIBIANE
 166 : C
 166 :       CALL ECROBJ('EVOLUTIO',JVITE)
 166 :       CALL ECROBJ('EVOLUTIO',JDEPL)
 167 : C
 168 : C
 169 :  666  CONTINUE
 170 :       RETURN
 171 :       END
 172 :  
 173 :  
 174 :  
 175 :  

© Cast3M 2003 - All rights reserved.
Disclaimer