Télécharger la plaquette Cast3M


fr en

Télécharger chomoy.eso

Retour à la liste

Numérotation des lignes : 

chomoy

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

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