Télécharger chomoy.eso

Retour à la liste

Numérotation des lignes :

  1. C CHOMOY SOURCE CHAT 05/01/12 22:01:28 5004
  2. SUBROUTINE CHOMOY
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. CHARACTER *72 TI
  6. CHARACTER *8 IACQ,IDCL,ITMOT
  7. CHARACTER *4 MOLU,ICHO
  8. C
  9. C=======================================================================
  10. C = CALCUL D'UN CHOC MOYEN A PARTIR D'UNE COURBE CONTENANT N CHOCS =
  11. C = =
  12. C = SYNTAXE : EVO2 = CMOY EVO1 (NCHO) (DECL V1) ACQU V2 ; =
  13. C = =
  14. C = IL PEUT Y AVOIR PLUSIEURS COURBES A TRAITER DANS EVO1; A CHACUNE =
  15. C = D'ELLES CORRESPOND UNE COURBE CHOC MOYEN DANS EVO2. =
  16. C = NCHO EST L'ENTIER NOMBRE DE CHOCS A MOYENNER =
  17. C = V1 EST LE SEUIL (EN % DE LA VALEUR MAXIE) DE DECLENCHEMENT =
  18. C = DE L'ACQUISITION D'UN IMPACT DANS EVO1; (OBJET DE TYPE FLOTTANT )=
  19. C = V2 EST LE TEMPS D'ACQUISITION DU CHOC A CHAQUE DECLENCHEMENT =
  20. C = (OBJET DE TYPE FLOTTANT) =
  21. C = =
  22. C = =
  23. C=======================================================================
  24. C
  25. -INC CCOPTIO
  26. -INC SMEVOLL
  27. -INC SMLREEL
  28. C
  29. DATA IDCL,IACQ,ITMOT/'DECLENCH','ACQUISIT','MOT '/
  30. DATA ICHO/'NCHO'/
  31. C
  32. CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET)
  33. IF(IERR.NE.0) GOTO 100
  34. C
  35. C LECTURE D'UN MOT-CLE ET DE SA DONNEE CORRESPONDANTE
  36. C
  37. DECLEN=0.D0
  38. ACQUI=0.D0
  39. DO 1 J=1,3
  40. MOLU=' '
  41. CALL LIRCHA(MOLU,0,IRETOU)
  42. IF(IIMPI.EQ.1)WRITE(IOIMP,9999)MOLU
  43. 9999 FORMAT(' MOT LU :',A4)
  44. IF(IERR.NE.0) GOTO 100
  45. IF((IRETOU.EQ.0).AND.(ACQUI.EQ.0.D0)) THEN
  46. C *** LE TEMPS D'ACQUISITION EST OBLIGATOIRE
  47. MOTERR(1:4)=IACQ(1:4)
  48. CALL ERREUR(396)
  49. GOTO 100
  50. ELSEIF(IRETOU.EQ.0) THEN
  51. GOTO 1
  52. ENDIF
  53. C
  54. IF(MOLU.EQ.IACQ(:4)) THEN
  55. C ENTREE DU TEMPS D'ACQUISITION (OBLIGATOIRE)
  56. CALL LIRREE(ACQUI,0,IRET)
  57. IF(IERR.NE.0) GOTO 100
  58. IF(IRET.EQ.0) THEN
  59. MOTERR(1:4)=IACQ(1:4)
  60. CALL ERREUR(166)
  61. GOTO 100
  62. ENDIF
  63. IF(ACQUI.LE.0.D0)THEN
  64. C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE
  65. MOTERR(1:8)=IACQ(1:8)
  66. REAERR(1)=ACQUI
  67. REAERR(2)=0.D0
  68. CALL ERREUR(41)
  69. GOTO 100
  70. ENDIF
  71. ENDIF
  72. C
  73. IF(MOLU.EQ.IDCL(:4)) THEN
  74. C ENTREE DU NIVEAU DE DECLENCHEMENT (FACULTATIF)
  75. CALL LIRREE(DECLEN,0,IDECL)
  76. IF(IERR.NE.0) GOTO 100
  77. IF((DECLEN.LT.0.D0).OR.(DECLEN.GT.100.D0)) THEN
  78. C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE
  79. MOTERR(1:8)=IDCL(1:8)
  80. REAERR(1)=DECLEN
  81. REAERR(2)=0.D0
  82. REAERR(3)=100.D0
  83. CALL ERREUR(42)
  84. GOTO 100
  85. ENDIF
  86. ENDIF
  87. C
  88. NCHO=0
  89. IF(MOLU.EQ.ICHO) THEN
  90. C ENTREE DU NOMBRE DE CHOCS A TRAITER (FACULTATIF)
  91. CALL LIRENT(NCHO,0,IRET)
  92. IF(IERR.NE.0) GOTO 100
  93. IF(IRET.EQ.0) THEN
  94. MOTERR(1:4)=ICHO(1:4)
  95. CALL ERREUR(166)
  96. GOTO 100
  97. ENDIF
  98. IF(NCHO.LT.0) THEN
  99. C *** LA VALEUR DONNEE N'EST PAS SATISFAISANTE
  100. INTERR(1)=0
  101. INTERR(2)=NCHO
  102. CALL ERREUR(190)
  103. ENDIF
  104. ENDIF
  105. C
  106. 1 CONTINUE
  107. C
  108. C
  109. MEVOL1=IPEVO
  110. SEGACT MEVOL1
  111. NC=MEVOL1.IEVOLL(/1)
  112. N=NC
  113. SEGINI MEVOLL
  114. ISOLU=MEVOLL
  115. TI(1:72)=TITREE
  116. IEVTEX=TI
  117. ITYEVO=MEVOL1.ITYEVO
  118. C
  119. C BOUCLE SUR LES COURBES
  120. C
  121. DO 10 IC=1,NC
  122. KEVOL1=MEVOL1.IEVOLL(IC)
  123. SEGACT KEVOL1
  124. MLREE1=KEVOL1.IPROGX
  125. SEGACT MLREE1
  126. MLREE2=KEVOL1.IPROGY
  127. SEGACT MLREE2
  128. L1=MLREE1.PROG(/1)
  129. DL=MLREE1.PROG(2)-MLREE1.PROG(1)
  130. C
  131. SEGINI KEVOLL
  132. IEVOLL(IC)=KEVOLL
  133. NOMEVX=KEVOL1.NOMEVX
  134. NOMEVY=KEVOL1.NOMEVY
  135. NUMEVX=KEVOL1.NUMEVX
  136. NUMEVY=KEVOL1.NUMEVY
  137. TYPX=KEVOL1.TYPX
  138. TYPY=KEVOL1.TYPY
  139. KEVTEX=TI
  140. JG=0
  141. SEGINI MLREEL
  142. IPROGY=MLREEL
  143. SEGINI MLREE3
  144. IPROGX=MLREE3
  145. C
  146. VMAX=0.D0
  147. MCHO=0
  148. C
  149. C CHERCHE LE NIVEAU DE DECLENCHEMENT
  150. C
  151. DO 20 I=1,L1
  152. FORC=ABS(MLREE2.PROG(I))
  153. IF(FORC.GT.VMAX)VMAX=FORC
  154. 20 CONTINUE
  155. SEUIL=DECLEN*VMAX/100.D0
  156. IF(IDECL.EQ.0) SEUIL=1.D-10
  157. IF(IIMPI.EQ.1) THEN
  158. WRITE(IOIMP,1000)SEUIL
  159. WRITE(IOIMP,1006)ACQUI
  160. 1000 FORMAT(' NIVEAU DE DECLENCHEMENT = ',1PE12.5)
  161. 1006 FORMAT(' TEMPS D''ACQUISITION = ',1PE12.5)
  162. ENDIF
  163. C
  164. C CHERCHE LE NOMBRE DE PAS D'ACQUISITION
  165. C
  166. NACQ=INT(ACQUI/DL)
  167. NRECU=INT(DBLE(NACQ)*0.201D0)
  168. NAVAN=NACQ-NRECU
  169. IF(IIMPI.EQ.1)THEN
  170. WRITE(IOIMP,1001)NACQ
  171. WRITE(IOIMP,1002)NRECU
  172. WRITE(IOIMP,1003)NAVAN
  173. WRITE(IOIMP,1009)L1
  174. 1001 FORMAT(' NOMBRE DE PAS D''ACQUISITION = ',I4)
  175. 1002 FORMAT(' NOMBRE DE PAS DE RECUL = ',I4)
  176. 1003 FORMAT(' NOMBRE DE PAS D''AVANCE = ',I4)
  177. 1009 FORMAT(' NOMBRE DE PTS A TRAITER = ',I4)
  178. ENDIF
  179. C
  180. C ACCUMULE LES CHOCS
  181. C
  182. IJ=0
  183. DO 21 I=1,L1
  184. IJ=IJ+1
  185. FORC=ABS(MLREE2.PROG(IJ))
  186. IF(FORC.GT.SEUIL) THEN
  187. ID=IJ-NRECU
  188. C
  189. C ON OUBLIE LE PREMIER CHOC SI IL EST A CHEVAL SUR LE DEBUT DE LA
  190. C PROGRESSION
  191. IF(ID.LE.0)THEN
  192. IF(IIMPI.EQ.1)WRITE(IOIMP,1007)
  193. 1007 FORMAT(' CHOC A CHEVAL SUR DEBUT BLOC : NEGLIGE ')
  194. DO 211 II=(IJ+1),L1
  195. FORC=ABS(MLREE2.PROG(II))
  196. IF(FORC.LE.1.D-10) THEN
  197. IJ=II
  198. GOTO 24
  199. ENDIF
  200. 211 CONTINUE
  201. ENDIF
  202. C
  203. C ON OUBLIE LE DERNIER CHOC SI IL EST A CHEVAL SUR LA FIN DE LA
  204. C PROGRESSION
  205. IF((ID+NACQ).GT.L1) THEN
  206. IF(IIMPI.EQ.1)WRITE(IOIMP,1008)
  207. 1008 FORMAT(' CHOC A CHEVAL SUR FIN BLOC : NEGLIGE ')
  208. GOTO 11
  209. ENDIF
  210. C
  211. C
  212. IF(IIMPI.EQ.1)WRITE(IOIMP,1004)IJ,MLREE2.PROG(IJ)
  213. 1004 FORMAT(' DEBUT DE CHOC AU PT ',I4,' AMPLITUDE A CE PAS = ',
  214. & 1PE12.5)
  215. MCHO=MCHO+1
  216. IF(IIMPI.EQ.1)WRITE(IOIMP,1005)MCHO
  217. 1005 FORMAT(' CHOC NUMERO ',I3)
  218. IF(MCHO.EQ.1) THEN
  219. JG=1+NACQ
  220. SEGADJ MLREEL
  221. DO 22 JJ=ID,(ID+NACQ)
  222. FORC=ABS(MLREE2.PROG(JJ))
  223. PROG(1+JJ-ID)=FORC
  224. 22 CONTINUE
  225. ELSE
  226. IND=0
  227. DO 23 JJ=ID,(ID+NACQ)
  228. IND=IND+1
  229. FORC=ABS(MLREE2.PROG(JJ))
  230. PROG(IND)=PROG(IND)+FORC
  231. 23 CONTINUE
  232. ENDIF
  233. IF(MCHO.EQ.NCHO)GOTO 11
  234. IJ=IJ+NAVAN
  235. ENDIF
  236. 24 IF(IJ.GE.L1)GOTO 11
  237. 21 CONTINUE
  238. C
  239. C DESACTIVE TOUT
  240. C
  241. 11 CONTINUE
  242. IF(MCHO.EQ.0) THEN
  243. C
  244. C PAS DE CHOCS RENCONTRES
  245. C
  246. JG0=PROG(/1)
  247. JG=JG0+NACQ+1
  248. SEGADJ MLREEL
  249. JG1=MLREE3.PROG(/1)
  250. JG=JG1+NACQ+1
  251. SEGADJ MLREE3
  252. DO 13 IK=1,NACQ+1
  253. PROG(JG0+IK)=0.D0
  254. MLREE3.PROG(JG1+IK)=(IK-1)*DL
  255. 13 CONTINUE
  256. ELSE
  257. C
  258. C DIVISE LES VALEURS OBTENUS PAR LE NOMBRE DE CHOCS
  259. C
  260. JG1=MLREE3.PROG(/1)
  261. JG=JG1+NACQ+1
  262. SEGADJ MLREE3
  263. FMCHO=DBLE(MCHO)
  264. DO 12 IJ=1,NACQ+1
  265. PROG(IJ)=PROG(IJ)/FMCHO
  266. MLREE3.PROG(JG1+IJ)=(IJ-1)*DL
  267. 12 CONTINUE
  268. ENDIF
  269. SEGDES MLREE1,MLREE2
  270. SEGDES KEVOLL
  271. C
  272. SEGDES MLREEL,MLREE3
  273. SEGDES KEVOLL
  274. C
  275. 10 CONTINUE
  276. SEGDES MEVOL1
  277. SEGDES MEVOLL
  278. C
  279. CALL ECROBJ('EVOLUTIO',ISOLU)
  280. C
  281. 100 CONTINUE
  282. RETURN
  283. END
  284.  
  285.  

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