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