Télécharger la plaquette Cast3M


fr en

Télécharger clcrit.eso

Retour à la liste

Numérotation des lignes : 

clcrit

  1. C CLCRIT    SOURCE    CHAT      05/01/12    22:04:33     5004
  2.       SUBROUTINE CLCRIT (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD,KOMPR,
  3.      .          JECRO,KRITER,KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3)
  4. C
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. C
  11.       DIMENSION SIGMA(*),DSIGT(*),SIGMAT(6),SIG(3),VECP(3),JECRO(*),
  12.      .          DEFP(*),DDEFP(*),DEFPT(6),DEFRF(*),RT(*),KOMPR(*)
  13. C
  14. C INITIALISATION
  15. C
  16.       RFE=1.D-8
  18.       KRITC1=0
  19.       KRITC2=0
  20.       KRITC3=0
  21.       KRITE1=0
  22.       KRITE2=0
  23.       KRITE3=0
  24. C
  25.       DO 10 I=1,6
  26.        SIGMAT(I)=SIGMA(I)+DSIGT(I)
  27.        DEFPT(I)=DEFP(I)+DDEFP(I)
  28.    10 CONTINUE
  29. C
  30. C **********************************************************************
  31. C ******************* CAS DE NB DE VECT PROPRES DONNES = 0 *************
  32. C **********************************************************************
  33. C
  34.       IF(NBVECD.EQ.0) THEN
  35. C
  36.         CALL VPMAX3 (SIGMAT,SIGMAX,VECP)
  37. C
  38.         IF(SIGMAX.GT.RT(3)) THEN
  39.           KRITC3=1
  41.         ENDIF
  42. C
  43.         RETURN
  44.       ENDIF
  45. C
  46. C **********************************************************************
  47. C ******************* CAS DE NB DE VECT PROPRES DONNES = 1 *************
  48. C **********************************************************************
  49. C
  50.       IF(NBVECD.EQ.1) THEN
  51. C
  52.         IF(ABS(DEFRF(3)).LT.1.D0) THEN
  53.           IF(DEFP(3).GT.DEFRF(3).AND.
  54.      .       (DDEFP(3).LT.0.D0.AND.ABS(DDEFP(3)).GT.RFE)) THEN
  55.             IF(DEFPT(3).LT.DEFRF(3)) THEN
  56.               KRITE3=1
  58.             ENDIF
  59.           ENDIF
  60.           IF(DEFP(3).LT.DEFRF(3).AND.
  61.      .       (DDEFP(3).GT.0.D0.AND.ABS(DDEFP(3)).GT.RFE)) THEN
  62.             IF(DEFPT(3).GT.DEFRF(3)) THEN
  63.               KRITE3=1
  65.             ENDIF
  66.           ENDIF
  67.         ENDIF
  68. C
  69.         IF(JECRO(3).NE.1) THEN
  70.           RTI=RT(3)
  71.           IF(KOMPR(3).EQ.1) RTI=0.D0
  72.           IF(SIGMAT(3).GT.RTI) THEN
  73.             KRITC3=1
  74.             IF(KRITE3.EQ.0) KRITER=KRITER+4
  75.           ENDIF
  76.         ENDIF
  77. C
  78.         SIG(1)=SIGMAT(1)
  79.         SIG(2)=SIGMAT(2)
  80.         SIG(3)=SIGMAT(4)
  81. C
  82.         IF(IIMPI.EQ.9) THEN
  83.           WRITE(IOIMP,*) 'SIGMAT1 =',SIG(1)
  84.           WRITE(IOIMP,*) 'SIGMAT2 =',SIG(2)
  85.           WRITE(IOIMP,*) 'SIGMAT4 =',SIG(3)
  86.         ENDIF
  87. C
  88.         CALL DIAGOD (SIG)
  89. C
  90.         IF(IIMPI.EQ.9) THEN
  91.           WRITE(IOIMP,*) 'SIG1 =',SIG(1)
  92.           WRITE(IOIMP,*) 'SIG2 =',SIG(2)
  93.           WRITE(IOIMP,*) 'ANGL =',SIG(3)
  94.         ENDIF
  95. C
  96.         IF(SIG(1).GT.RT(1)) THEN
  97.           KRITC1=1
  99.         ENDIF
  100. C
  101.         IF(SIG(2).GT.RT(2)) THEN
  102.           KRITC2=1
  104.         ENDIF
  105. C
  106.         RETURN
  107.       ENDIF
  108. C
  109. C **********************************************************************
  110. C ******************* CAS DE NB DE VECT PROPRES DONNES = 2 *************
  111. C **********************************************************************
  112. C
  113.       IF(NBVECD.EQ.2) THEN
  114. C
  115.         IF(ABS(DEFRF(1)).LT.1.D0) THEN
  116.           IF(DEFP(1).GT.DEFRF(1).AND.
  117.      .       (DDEFP(1).LT.0.D0.AND.ABS(DDEFP(1)).GT.RFE)) THEN
  118.             IF(DEFPT(1).LT.DEFRF(1)) THEN
  119.               KRITE1=1
  121.             ENDIF
  122.           ENDIF
  123.           IF(DEFP(1).LT.DEFRF(1).AND.
  124.      .       (DDEFP(1).GT.0.D0.AND.ABS(DDEFP(1)).GT.RFE)) THEN
  125.             IF(DEFPT(1).GT.DEFRF(1)) THEN
  126.               KRITE1=1
  128.             ENDIF
  129.           ENDIF
  130.         ENDIF
  131. C
  132.         IF(JECRO(1).NE.1) THEN
  133.           RTI=RT(1)
  134.           IF(KOMPR(1).EQ.1) RTI=0.D0
  135.           IF(SIGMAT(1).GT.RTI) THEN
  136.             KRITC1=1
  137.             IF(KRITE1.EQ.0) KRITER=KRITER+1
  138.           ENDIF
  139.         ENDIF
  140. C
  141.         IF(ABS(DEFRF(2)).LT.1.D0) THEN
  142.           IF(DEFP(2).GT.DEFRF(2).AND.
  143.      .       (DDEFP(2).LT.0.D0.AND.ABS(DDEFP(2)).GT.RFE)) THEN
  144.             IF(DEFPT(2).LT.DEFRF(2)) THEN
  145.               KRITE2=1
  147.             ENDIF
  148.           ENDIF
  149.           IF(DEFP(2).LT.DEFRF(2).AND.
  150.      .       (DDEFP(2).GT.0.D0.AND.ABS(DDEFP(2)).GT.RFE)) THEN
  151.             IF(DEFPT(2).GT.DEFRF(2)) THEN
  152.               KRITE2=1
  154.             ENDIF
  155.           ENDIF
  156.         ENDIF
  157. C
  158.         IF(JECRO(2).NE.1) THEN
  159.           RTI=RT(2)
  160.           IF(KOMPR(2).EQ.1) RTI=0.D0
  161.           IF(SIGMAT(2).GT.RTI) THEN
  162.             KRITC2=1
  163.             IF(KRITE2.EQ.0) KRITER=KRITER+2
  164.           ENDIF
  165.         ENDIF
  166. C
  167.         IF(ABS(DEFRF(3)).LT.1.D0) THEN
  168.           IF(DEFP(3).GT.DEFRF(3).AND.
  169.      .       (DDEFP(3).LT.0.D0.AND.ABS(DDEFP(3)).GT.RFE)) THEN
  170.             IF(DEFPT(3).LT.DEFRF(3)) THEN
  171.               KRITE3=1
  173.             ENDIF
  174.           ENDIF
  175.           IF(DEFP(3).LT.DEFRF(3).AND.
  176.      .       (DDEFP(3).GT.0.D0.AND.ABS(DDEFP(3)).GT.RFE)) THEN
  177.             IF(DEFPT(3).GT.DEFRF(3)) THEN
  178.               KRITE3=1
  180.             ENDIF
  181.           ENDIF
  182.         ENDIF
  183. C
  184.         IF(JECRO(3).NE.1) THEN
  185.           RTI=RT(3)
  186.           IF(KOMPR(3).EQ.1) RTI=0.D0
  187.           IF(SIGMAT(3).GT.RTI) THEN
  188.             KRITC3=1
  189.             IF(KRITE3.EQ.0) KRITER=KRITER+4
  190.           ENDIF
  191.         ENDIF
  192. C
  193.         RETURN
  194.       ENDIF
  195. C
  196.       END
  197.  
  198.  

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