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