Télécharger chafon.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAFON SOURCE CHAT 05/01/12 21:54:13 5004
  2. SUBROUTINE CHAFON(EPST,F1,F2,F3, DYK,SI,
  3. . C1,C2,ITYP,ICENT2,IDIAM,G,R,IBOU,ELT,HDEP,R0,RM,B,ICAS,WEP,
  4. . SINT,X1INT,X2INT,PSI,OME,ecou)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. DIMENSION F1(*),F2(*),F3(*),DYK(*),SINT(*),X1INT(*),X2INT(*)
  8. C
  9. * Commun ECOU: sert de fourre-tout pour les tableaux
  10. *
  11. SEGMENT ECOU
  12. *** COMMON/ECOU/TEST,ALFAH,
  13. REAL*8 TEST, ALFAH,
  14. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  15. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),X1(6),X2(6),
  16. 1 DALPHA(6),DSIGO(6),S(12),XINV(3),
  17. 2 SIPLAD(6),DSIGP0(6),TET,TETI
  18. ENDSEGMENT
  19. C COMMON/ECOU/TEST,ALFAH,
  20. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  21. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),X1(6),X2(6),
  22. C 1 DALPHA(6),DSIGO(6),S(12),XINV(3),
  23. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  24. C
  25. C LES CONTRAINTES SONT DANS S ET LE VON-MISES CORRESPONDANT EST
  26. C DANS SI
  27. C ICAS = 1 ON CHERCHE UNE PREMIERE ESTIMATION DU HDEP
  28. C ICAS = 2 ON CALCULE LE VECTEUR INCREMENT DYK ET ON MET A JOUR
  29. C S ,SI,X1,X2
  30. C ICAS = 3 ON CALCULE LA PENTE ( STOCKEE DANS WEP ) POUR LA
  31. C DETERMINATION DU DEPSI
  32. C DANS DYK ON STOCKE DANS L ORDRE : SIG-X1-X2,X1,X2
  33. C R EST CALCULE EN ENTREE POUR UN EPST DONNE
  34. C
  35. IF(IDIAM.NE.0) R=RM-(RM-R0)*EXP(-B*EPST)
  36. PHI=1.D00
  37. IF(PSI.NE.1.D00) PHI=1.D00+(PSI-1.D00)*EXP(-OME*EPST)
  38. UNSUR=1./SI
  39. H=B*(RM-R)
  40. GO TO (101,102,103,104,105,106,107,108,109,999,
  41. . 999,999,113,114),ITYP
  42. 101 F1(1)=(S(1)-0.5*(S(2)+S(3)))*UNSUR
  43. F1(2)=(S(2)-0.5*(S(1)+S(3)))*UNSUR
  44. F1(3)=(S(3)-0.5*(S(1)+S(2)))*UNSUR
  45. DO 10 I=4,6
  46. F1(I)=3.*S(I)*UNSUR
  47. F2(I)=F1(I)*0.5
  48. 10 F3(I)=G*F1(I)
  49. DO 11 I=1,3
  50. 11 F2(I)=F1(I)
  51. F3(1)=S(7)*F1(1)+S(8)*(F1(2)+F1(3))
  52. F3(2)=S(7)*F1(2)+S(8)*(F1(1)+F1(3))
  53. F3(3)=S(7)*F1(3)+S(8)*(F1(1)+F1(2))
  54. DUM=H+1.5*ELT
  55. GO TO (111,300,300),ICAS
  56. 111 DUM=DUM+1.5*S(9)*PHI
  57. GO TO 200
  58. 102 IBO=2
  59. I3=3
  60. AL1=SQRT(ALFAH)
  61. GO TO 121
  62. 103 I3=3
  63. GO TO 110
  64. 106 I3=4
  65. 110 IBO=1
  66. 121 DUM=H
  67. DO 125 IPP=1,IBO
  68. IP=3*(IPP-1)
  69. IP1=IP+1
  70. IP2=IP+2
  71. IP3=IP+I3
  72. F1(IP1)=(S(IP1)-0.5*S(IP2))*UNSUR
  73. F1(IP2)=(S(IP2)-0.5*S(IP1))*UNSUR
  74. IF(ITYP.NE.6) GO TO 127
  75. F1(3)=0.
  76. F2(3)=0.
  77. F3(3)=0.
  78. 127 CONTINUE
  79. F1(IP3)=3.*S(IP3)*UNSUR
  80. F2(IP1)=S(IP1)*UNSUR
  81. F2(IP2)=S(IP2)*UNSUR
  82. F2(IP3)=S(IP3)*UNSUR
  83. F3(IP1)=S(7)*F1(IP1)+S(8)*F1(IP2)
  84. F3(IP2)=S(7)*F1(IP2)+S(8)*F1(IP1)
  85. F3(IP3)=G*F1(IP3)
  86. DUM2=F1(IP1)*F3(IP1)+F1(IP2)*F3(IP2)+F1(IP3)*F3(IP3)
  87. IF(ITYP.NE.2.OR.IPP.NE.1) GO TO 128
  88. DUM2=DUM2*ALFAH
  89. F1(IP1)=F1(IP1)*AL1
  90. F1(IP2)=F1(IP2)*AL1
  91. F1(IP3)=F1(IP3)*AL1
  92. 128 CONTINUE
  93. DUM=DUM+DUM2
  94. 125 CONTINUE
  95. GO TO (124,300,300),ICAS
  96. 124 DUM=DUM+S(9)*PHI
  97. GO TO 200
  98. 104 I1=3
  99. GO TO 140
  100. 107 AL1=SQRT(ALFAH)
  101. 108 I1=1
  102. 140 DUM=H
  103. DO 141 I=1,IBOU
  104. F1(I)=0.
  105. F2(I)=0.
  106. 141 F3(I)=0.
  107. F1(I1)=S(I1)*UNSUR
  108. F2(I1)=F1(I1)
  109. F3(I1)=S(7)*F1(I1)
  110. DUM2=F1(I1)*F3(I1)
  111. IF(ITYP.NE.7) GO TO 142
  112. DUM2=DUM2*ALFAH
  113. F1(I1)=F1(I1)*AL1
  114. F1(4)=S(4)*UNSUR
  115. F2(4)=F1(4)
  116. F3(4)=S(7)*F1(4)
  117. DUM=DUM+F1(4)*F3(4)
  118. 142 DUM=DUM+DUM2
  119. GO TO (124,300,300),ICAS
  120. 113 DUM=H
  121. F1(1)=(S(1)-0.5*S(2))*UNSUR
  122. F1(2)=(S(2)-0.5*S(1))*UNSUR
  123. F1(3)=0.
  124. F2(3)=0.
  125. F3(3)=0.
  126. DO 1113 IB=4,6
  127. F1(IB)=3.*S(IB)*UNSUR
  128. F2(IB)=S(IB)*UNSUR
  129. F3(IB)=G*F1(IB)
  130. 1113 CONTINUE
  131. F2(1)=S(1)*UNSUR
  132. F2(2)=S(2)*UNSUR
  133. F3(1)=S(7)*F1(1)+S(8)*F1(2)
  134. F3(2)=S(7)*F1(2)+S(8)*F1(1)
  135. DUM2=F1(1)*F3(1)+F1(2)*F3(2)+F1(4)*F3(4)+F1(5)*F3(5)+F1(6)*F3(6)
  136. DUM=DUM+DUM2
  137. GO TO (124,300,300),ICAS
  138. C= Modes de calcul UNIDIMENSIONNELs (1D)
  139. 114 F1(1)=(S(1)-0.5*(S(2)+S(3)))*UNSUR
  140. F1(2)=(S(2)-0.5*(S(1)+S(3)))*UNSUR
  141. F1(3)=(S(3)-0.5*(S(1)+S(2)))*UNSUR
  142. F2(1)=F1(1)
  143. F2(2)=F1(2)
  144. F2(3)=F1(3)
  145. F3(1)=S(7)*F1(1)+S(8)*(F1(2)+F1(3))
  146. F3(2)=S(7)*F1(2)+S(8)*(F1(1)+F1(3))
  147. F3(3)=S(7)*F1(3)+S(8)*(F1(1)+F1(2))
  148. DUM=H+1.5*ELT
  149. GO TO (1140,300,300),ICAS
  150. 1140 DUM=DUM+1.5*S(9)*PHI
  151. GO TO 200
  152. 105 CONTINUE
  153. 109 CONTINUE
  154. C-----------------------------------------------------------------------
  155. C ICAS = 1
  156. C-----------------------------------------------------------------------
  157. 200 CONTINUE
  158. DO 1 I=1,IBOU
  159. DUM=DUM-C1*F1(I)*X1(I)
  160. IF(ICENT2.EQ.0) GO TO 1
  161. DUM=DUM-C2*F1(I)*X2(I)
  162. 1 CONTINUE
  163. HDEP=(SI-R)/DUM
  164. RETURN
  165. C-----------------------------------------------------------------------
  166. C ICAS = 2 OU 3
  167. C-----------------------------------------------------------------------
  168. 300 CONTINUE
  169. DO 2 I=1,IBOU
  170. DYK(6+I)=(S(10)*PHI*F2(I)-C1*X1(I))*HDEP
  171. X1(I)=X1INT(I)+DYK(6+I)*WEP
  172. IF(ICENT2.EQ.0) GO TO 2
  173. DYK(12+I)=(S(11)*PHI*F2(I)-C2*X2(I))*HDEP
  174. X2(I)=X2INT(I)+DYK(12+I)*WEP
  175. 2 CONTINUE
  176. DO 3 I=1,IBOU
  177. DYK(I)=-F3(I)*HDEP -DYK(6+I)
  178. IF(ICENT2.EQ.0) GO TO 33
  179. DYK(I)=DYK(I) -DYK(12+I)
  180. 33 S(I)=SINT(I)+DYK(I)*WEP
  181. 3 CONTINUE
  182. SI=VONMIS(S,ITYP,ALFAH,COVNMS)
  183. IF(ICAS.EQ.2) RETURN
  184. C
  185. C CALCUL DE LA PENTE POUR LA DETERMINATION DU DEPSI
  186. C
  187. WEP=H
  188. DO 631 IB=1,IBOU
  189. 631 WEP=WEP-F1(IB)*DYK(IB)/HDEP
  190. RETURN
  191. 999 WRITE(6,7999)
  192. 7999 FORMAT('0 CHAFON - CAS NON IMPLEMENTE '/)
  193. RETURN
  194. END
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  

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