Télécharger totemp.eso

Retour à la liste

Numérotation des lignes :

totemp
  1. C TOTEMP SOURCE BP208322 18/12/10 21:15:04 10034
  2. SUBROUTINE TOTEMP
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C
  8. C CALCUL DU TEMPS TOTAL OU LES ORDONNEES D'UNE COURBE SONT
  9. C SUPERIEURES A UN SEUIL DONNE; LE SEUIL EST DEFINI PAR UN % DU
  10. C NIVEAU MAXIMA DES CHOC.
  11. C LA COURBE EST DANS UN OBJET DE TYPE EVOLUTIO; CET OBJET PEUT
  12. C AVOIR PLUSIEURS EVOLUTIO ELEMENTAIRES
  13. C
  14. C SYNTAXE : TEMP = TOTE EVOL DECL ;
  15. C
  16. C LES ABSCISSES SONT SUPPOSEES CLASSEES DANS UN ORDRE CROISSANT
  17. C LE RESULTAT EST UN FLOTTANT.
  18. C
  19. C TEMP : OBJET DE TYPE LISTREEL RESULTAT
  20. C EVOL : OBJET DE TYPE EVOLUTIO CONTENANT LES ENREGISTREMENTS
  21. C DECL : OBJET DE TYPE FLOTTANT % DU NIVEAU MAXIMA
  22. C
  23. C BP, 2016-05-02 : on reecrit beaucoup (en coherence avec COMT)
  24. C
  25. C=======================================================================
  26. C
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMEVOLL
  31. -INC SMLREEL
  32. -INC CCREEL
  33.  
  34. LOGICAL ZSEUIL
  35.  
  36.  
  37. C=======================================================================
  38. C LECTURE DES OBJETS EN ENTREE
  39. C=======================================================================
  40.  
  41. C EVOLUTION
  42. CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET)
  43. IF(IERR.NE.0) RETURN
  44.  
  45. C SEUIL (EN %)
  46. CALL LIRREE(DECLEN,0,IDECL)
  47. IF(IERR.NE.0) RETURN
  48. IF(IDECL.EQ.0) THEN
  49. c sqrt(1.E-16)*100 ~ 1.E-6
  50. DECLEN=1.D-6
  51. ELSE
  52. CBP IF((DECLEN.LT.0.D0).OR.(DECLEN.GT.100.D0))THEN
  53. IF((DECLEN.LE.0.D0).OR.(DECLEN.GE.100.D0))THEN
  54. MOTERR(1:8)='DECLENCH'
  55. REAERR(1)=DECLEN
  56. REAERR(2)=0.D0
  57. REAERR(3)=100.D0
  58. CALL ERREUR(42)
  59. RETURN
  60. ENDIF
  61. DECLEN=MAX(DECLEN,(100.D0*XZPREC))
  62. ENDIF
  63. C
  64. C=======================================================================
  65. C TRAVAIL
  66. C=======================================================================
  67.  
  68. MEVOLL=IPEVO
  69. SEGACT MEVOLL
  70. NC=IEVOLL(/1)
  71. JG = NC
  72. SEGINI MLREEL
  73. IPORE=MLREEL
  74. C
  75. C --- BOUCLE SUR LES COURBES ---
  76. C
  77. DO 1 IC=1,NC
  78. KEVOLL=IEVOLL(IC)
  79. SEGACT KEVOLL
  80. MLREE1=IPROGX
  81. SEGACT MLREE1
  82. MLREE2=IPROGY
  83. SEGACT MLREE2
  84. L1=MLREE1.PROG(/1)
  85. TEMP=0.D0
  86. NP=0
  87. C
  88. C CALCUL DU NIVEAU DE DECLENCHEMENT
  89. VMAX=0.D0
  90. DO 10 I=1,L1
  91. FORC=ABS(MLREE2.PROG(I))
  92. IF(FORC.GT.VMAX) VMAX=FORC
  93. 10 CONTINUE
  94. SEUIL=VMAX*DECLEN/100.D0
  95. IF(IIMPI.GE.1) WRITE(IOIMP,11)SEUIL
  96. 11 FORMAT(' SEUIL D''ACQUISITION : ',1PE12.5)
  97.  
  98. C
  99. C CALCUL LA DUREE OU LE SIGNAL EST SUPERIEUR AU SEUIL
  100.  
  101. IDEB=0
  102. TEMP=0.D0
  103. FORC=ABS(MLREE2.PROG(1))
  104. ZSEUIL=FORC.GT.SEUIL
  105.  
  106. DO 20 I=2,L1
  107.  
  108. FORC=ABS(MLREE2.PROG(I))
  109. IF(ZSEUIL) THEN
  110. * seuil deja depasse au pas precedent : on ajoute le pas
  111. TEMP = TEMP + (MLREE1.PROG(I)-MLREE1.PROG(I-1))
  112. ZSEUIL=FORC.GT.SEUIL
  113. ELSE
  114. * on etait inferieur, et maintenant ?
  115. ZSEUIL=FORC.GT.SEUIL
  116. * on est sur un front montant : on ajoute le pas
  117. IF(ZSEUIL) TEMP = TEMP + (MLREE1.PROG(I)-MLREE1.PROG(I-1))
  118. ENDIF
  119.  
  120. 20 CONTINUE
  121. C
  122. C DESACTIVE TOUT
  123. SEGDES MLREE1,MLREE2
  124. SEGDES KEVOLL
  125. C
  126. C STOCKAGE DU TEMPS DE CHOCS
  127. PROG(IC)=TEMP
  128. C
  129. 1 CONTINUE
  130. C --- FIN DE BOUCLE SUR LES COURBES ---
  131.  
  132. SEGDES MEVOLL
  133. SEGDES MLREEL
  134. C
  135. CALL ECROBJ('LISTREEL',IPORE)
  136. C
  137. RETURN
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  

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