Télécharger clcrit.eso

Retour à la liste

Numérotation des lignes :

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

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