Télécharger sigelp.eso

Retour à la liste

Numérotation des lignes :

sigelp
  1. C SIGELP SOURCE PV 18/11/20 21:15:05 1001
  2. SUBROUTINE SIGELP(SIGMA,DSIGMA,SIGEL,DSIGP,STOT,STEST,ITYPE,
  3. 1 SEL,SPLA,IBOU,S0,SELAS,XMAT,COVNMS,ALFAH,IMAPLA,SSTAR)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. DIMENSION SIGMA(*),DSIGMA(*),STOT(*),SIGEL(*),DSIGP(*)
  7. 1,XMAT(*),COVNMS(*)
  8. DATA UN/1.0D0/,ZERO/0.0D0/
  9. -INC CCREEL
  10. C
  11. CCCCCCCCCCCCCCC CALCUL DE L INTERSECTION AVEC LE CONVEXE
  12. C
  13. CALL ZDANUL(SIGEL,6)
  14. CALL ZDANUL(DSIGP,6)
  15. AA=VONMIS(DSIGMA,ITYPE,ALFAH,COVNMS)
  16. BB=VNMS12(DSIGMA,SIGMA,ITYPE,ALFAH,COVNMS)
  17. AA=AA*AA
  18. AA1=AA
  19. BB1=BB
  20. TST=STEST*STEST
  21. IF(IMAPLA.EQ.11) GO TO 20
  22. C=S0*S0
  23. CC=C-SELAS*SELAS
  24. IF(IMAPLA.NE.5) GO TO 11
  25. C
  26. CCCCCCCCCCCCCC CAS DRUCKER PRAGER
  27. C
  28. EE=TRACE(DSIGMA)
  29. XMAT22=XMAT(2)*XMAT(2)
  30. XMAT11=XMAT(1)*XMAT(1)
  31. XMAT13=XMAT(1)*SELAS
  32. AA=AA*XMAT22-EE*EE*XMAT11
  33. BB=BB*XMAT22-EE*FF*XMAT11+XMAT13*EE
  34. GO TO 11
  35. 20 CONTINUE
  36. C
  37. CCCCCCCCCCCCAS CHEN ET CHEN
  38. C
  39. IN=0
  40. 90 CONTINUE
  41. IF (IN.EQ.0) GO TO 120
  42. AAA=AA
  43. BBB=BB
  44. CCC=CC
  45. DDD=DD
  46. BB=BB1
  47. AA=AA1
  48. 120 CONTINUE
  49. DINV1=TRACE(DSIGMA)
  50. AA=AA/3+IN*DINV1*DINV1/6
  51. CC=VONMIS(SIGMA,ITYPE,ALFAH,COVNMS)
  52. DINVO=TRACE(SIGMA)
  53. CC=CC*CC/3+IN*DINVO*DINVO/6+XMAT(2)*DINVO/3
  54. CC=CC+(-UN+XMAT(1)*DINVO/3)*SELAS*SELAS
  55. BB=BB*2/3+IN*DINV1*DINVO/3+DINV1*XMAT(2)/3
  56. BB=BB+XMAT(1)*SELAS*SELAS*DINV1/3
  57. BB=BB/2
  58. CCCCC
  59. 11 CONTINUE
  60. IF(ABS(AA).GT.TST) GO TO 1
  61. C
  62. CCCCCCCCCC AA EST NUL UNE SEULE SOLUTION
  63. C
  64. IF(ABS(BB).GT.TST) GO TO 10
  65. C
  66. CCCCCCCCCC BB EST NUL <=> DSIGMA=0 SIGMA0=STOT
  67. C
  68. 110 CONTINUE
  69. if (s0.lt.-xpetit/xzprec.or.s0.gt.xpetit/xzprec)then
  70. XX=SELAS/S0
  71. else
  72. xx=xgrand*xzprec
  73. endif
  74. CALL AEQBX(SIGEL,SIGMA,XX,IBOU)
  75. CALL AEQBPC(DSIGP,SIGMA,SIGEL,UN,-UN,IBOU)
  76. SEL=0.
  77. SPLA=1.
  78. GO TO 555
  79. 10 CONTINUE
  80. C
  81. CCCCCCCCCCCCCCAS BB NON NUL
  82. C
  83. SEL=CC/(2.*BB)
  84. GO TO 333
  85. 333 CALL AEQBPC(SIGEL,SIGMA,DSIGMA,UN,SEL,IBOU)
  86. SPLA=1.-SEL
  87. CALL AEQBX(DSIGP,DSIGMA,SPLA,IBOU)
  88. GO TO 555
  89. 1 CONTINUE
  90. C
  91. CCCCCCCCCCCCCC AA NON NUL ON A 2 SOLUTIONS
  92. C
  93. IF(ABS(CC).GT.TST) GO TO 2
  94. C
  95. CCCCCCCCCCCCCC 1 SEULE SOLUTION CC NUL
  96. C
  97. SEL=0.
  98. GO TO 333
  99. 2 CONTINUE
  100. C
  101. CCCCCCCCCCCC 2 SOLUTIONS
  102. C
  103. DD=4.*BB*BB-4.*AA*CC
  104. B=2.*BB
  105. IF(AA*CC.GT.0.) GO TO 3
  106. C
  107. CCCC CC EST NEGATIF ON A 2 SOLUTIONS 1 NEGATIVE 1 POSITIVE
  108. C LA BONNE EST LA POSITIVE
  109. C
  110. SEL=(-B+SQRT(DD))/(2.*AA)
  111. GO TO 333
  112. 3 CONTINUE
  113. C
  114. CCCCCCCC ON A 2 SOLUTIONS POSITIVES OU NEGATIVES
  115. C
  116. IF(DD.GT.0.) GO TO 5
  117. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  118. CCCCCCCCCCCCC LA DROITE S0 STOT NE COUPE PAS LE CONVEXE C
  119. C ON CHERCHE LE POINT DU CONVEXE LE C
  120. CCC PLUS PRES DE STOT ON L APPELLE SIGEL C
  121. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  122. 130 CONTINUE
  123. if (sSTAR.lt.-xpetit/xzprec.or.SSTAR.gt.xpetit/xzprec)then
  124. XX=SELAS/SSTAR
  125. else
  126. xx=xgrand*xzprec
  127. endif
  128. CALL AEQBX(SIGEL,STOT,XX,IBOU)
  129. SEL=0.D0
  130. SPLA=1.D0
  131. CALL AEQBPC(DSIGP,STOT,SIGEL,UN,-UN,IBOU)
  132. GO TO 555
  133. 5 CONTINUE
  134. C
  135. CCCCCCCCCCCCCCCCCCC ON A 2 SOLUTIONS POSITIVES OU NEGATIVES
  136. C
  137. SEL=(-B+SQRT(DD))/(2.*AA)
  138. GO TO 333
  139. 555 CONTINUE
  140. IF(IMAPLA.NE.11.OR.IN.EQ.1) GO TO 666
  141. IF(IN.EQ.0) GO TO 80
  142. IF(ABS(SELMIN).GE.ABS(SEL)) GO TO 666
  143. SEL=SELMIN
  144. IF(ABS(AAA).LT.TST.AND.ABS(BBB).LT.TST) GO TO 110
  145. IF(ABS(AAA).GT.TST.AND.ABS(CCC).GT.TST.AND.(AAA*CCC).GT.ZERO.
  146. . AND.DDD.LT.ZERO) GO TO 130
  147. IN=1
  148. GO TO 333
  149. 80 SELMIN=SEL
  150. IN=-1
  151. GO TO 90
  152. 666 CONTINUE
  153. RETURN
  154. END
  155.  
  156.  
  157.  

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