Télécharger la plaquette Cast3M


fr en

Télécharger clgama.eso

Retour à la liste

Numérotation des lignes : 

clgama

  1. C CLGAMA    SOURCE    CHAT      05/01/12    22:04:51     5004
  2.       SUBROUTINE CLGAMA (SIGMA,DSIGT,RT,DEFP,DDEFP,DEFRF,NBVECD,
  3.      .           KRITC1,KRITC2,KRITC3,KRITE1,KRITE2,KRITE3,GAMA,
  4.      .           YUNG,KOMPR,KERRE)
  5. C
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. C
  12.       DIMENSION SIGMA(*),DSIGT(*),SIGMAT(6),SIG(3),DSIG(3),KOMPR(*),
  13.      .          DEFP(*),DDEFP(*),DEFPT(6),DEFRF(*),RT(*),VGAMA(3,2)
  14. C
  15. C INITIALISATION
  16. C
  17.       GAMRF=1.D-7
  18.       DO 100 I=1,3
  19.       DO 100 J=1,2
  20.         VGAMA(I,J)=1.D0
  21.   100 CONTINUE
  22. C
  23. C **********************************************************************
  24. C ******************* CAS DE NB DE VECT PROPRES DONNES = 0 *************
  25. C **********************************************************************
  26. C
  27.       IF(NBVECD.EQ.0) THEN
  28. C
  29.         CALL GAMT3 (SIGMA,DSIGT,RT(3),YUNG,GAMA,KERRE)
  30.         IF (KERRE.NE.0) RETURN
  31. C
  32.         IF(ABS(GAMA).LT.GAMRF) GAMA=0.D0
  33. C
  34.         IF(IIMPI.EQ.9) THEN
  35.           WRITE(IOIMP,*) ' GAMA  =',GAMA
  36.         ENDIF
  37. C
  38.         RETURN
  39.       ENDIF
  40. C
  41. C **********************************************************************
  42. C ******************* CAS DE NB DE VECT PROPRES DONNES = 1 *************
  43. C **********************************************************************
  44. C
  45.       IF(NBVECD.EQ.1) THEN
  46. C
  47.         IF(KRITC3.EQ.1) THEN
  48.           RTI=RT(3)
  49.           IF (KOMPR(3).EQ.1) RTI=0.D0
  50.           CALL GAMTAF (SIGMA(3),DSIGT(3),RTI,VGAMA(3,1))
  51.         ENDIF
  52. C
  53.         IF(KRITE3.EQ.1) THEN
  54.           CALL GAMTAF (DEFP(3),DDEFP(3),DEFRF(3),VGAMA(3,2))
  55.         ENDIF
  56. C
  57.         IF(KRITC1.EQ.1.OR.KRITC2.EQ.1) THEN
  58.           CALL GAMT2 (SIGMA,DSIGT,RT(1),YUNG,VGAMA(1,1))
  59.         ENDIF
  60. C
  61.         GAMA=MIN (VGAMA(1,1),VGAMA(3,1),VGAMA(3,2))
  62. C
  63.         IF(ABS(GAMA).LT.GAMRF) GAMA=0.D0
  64. C
  65.         IF(IIMPI.EQ.9) THEN
  66.           WRITE(IOIMP,*) ' GAMA  =',GAMA
  67.           WRITE(IOIMP,*) 'VGAMA11=',VGAMA(1,1)
  68.           WRITE(IOIMP,*) 'VGAMA32=',VGAMA(3,2)
  69.         ENDIF
  70. C
  71.         RETURN
  72.       ENDIF
  73. C
  74. C **********************************************************************
  75. C ******************* CAS DE NB DE VECT PROPRES DONNES = 2 *************
  76. C **********************************************************************
  77. C
  78.       IF(NBVECD.EQ.2) THEN
  79. C
  80.         IF(KRITC1.EQ.1) THEN
  81.           RTI=RT(1)
  82.           IF (KOMPR(1).EQ.1) RTI=0.D0
  83.           CALL GAMTAF (SIGMA(1),DSIGT(1),RTI,VGAMA(1,1))
  84.         ENDIF
  85. C
  86.         IF(KRITE1.EQ.1) THEN
  87.           CALL GAMTAF (DEFP(1),DDEFP(1),DEFRF(1),VGAMA(1,2))
  88.         ENDIF
  89. C
  90.         IF(KRITC2.EQ.1) THEN
  91.           RTI=RT(2)
  92.           IF (KOMPR(2).EQ.1) RTI=0.D0
  93.           CALL GAMTAF (SIGMA(2),DSIGT(2),RTI,VGAMA(2,1))
  94.         ENDIF
  95. C
  96.         IF(KRITE2.EQ.1) THEN
  97.           CALL GAMTAF (DEFP(2),DDEFP(2),DEFRF(2),VGAMA(2,2))
  98.         ENDIF
  99. C
  100.         IF(KRITC3.EQ.1) THEN
  101.           RTI=RT(3)
  102.           IF (KOMPR(3).EQ.1) RTI=0.D0
  103.           CALL GAMTAF (SIGMA(3),DSIGT(3),RTI,VGAMA(3,1))
  104.         ENDIF
  105. C
  106.         IF(KRITE3.EQ.1) THEN
  107.           CALL GAMTAF (DEFP(3),DDEFP(3),DEFRF(3),VGAMA(3,2))
  108.         ENDIF
  109. C
  110.         GAMA=MIN (VGAMA(1,1),VGAMA(1,2),
  111.      .            VGAMA(2,1),VGAMA(2,2),
  112.      .            VGAMA(3,1),VGAMA(3,2))
  113. C
  114.         IF(ABS(GAMA).LT.GAMRF) GAMA=0.D0
  115. C
  116.         IF(IIMPI.EQ.9) THEN
  117.           WRITE(IOIMP,*) ' GAMA  =',GAMA
  118.           WRITE(IOIMP,*) 'VGAMA11=',VGAMA(1,1)
  119.           WRITE(IOIMP,*) 'VGAMA12=',VGAMA(1,2)
  120.           WRITE(IOIMP,*) 'VGAMA21=',VGAMA(2,1)
  121.           WRITE(IOIMP,*) 'VGAMA22=',VGAMA(2,2)
  122.           WRITE(IOIMP,*) 'VGAMA31=',VGAMA(3,1)
  123.           WRITE(IOIMP,*) 'VGAMA32=',VGAMA(3,2)
  124.         ENDIF
  125. C
  126.         RETURN
  127.       ENDIF
  128. C
  129.       END
  130.  
  131.  

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