Télécharger la plaquette Cast3M


fr en

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