Télécharger projvm.eso

Retour à la liste

Numérotation des lignes :

  1. C PROJVM SOURCE GG250959 17/09/20 21:16:15 9554
  2. SUBROUTINE PROJVM(SIG,EPS,EPST,EPSTAR,DEPS,PENTE,SN,
  3. . PANTIN,SELAS,ITER,SO,SSTAR,SI,NK,IBOU,COEF,JKI,
  4. . KERRE,ecou,necou)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. C
  8. C CALCULE L ECOULEMENT EN CAS DE CRITERE DE VON MISES
  9. C
  10. DIMENSION SIG(*),EPS(*),COEF(*)
  11. C
  12. SEGMENT ECOU
  13. C** COMMON/ECOU/TEST,ALFAH,
  14. REAL*8 TEST, ALFAH,
  15. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  16. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  17. 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  18. 2 SIPLAD(6),DSIGP0(6),TETM,TETI
  19. ENDSEGMENT
  20. C COMMON/ECOU/TEST,ALFAH,
  21. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  22. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  23. C 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  24. C 2 SIPLAD(6),DSIGP0(6),TETM,TETI
  25. C
  26. SEGMENT NECOU
  27. C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  28. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  29. . ITYP,IFOUR,IFLUAG,
  30. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  31. . JFLUAG,KFLUAG,LFLUAG,
  32. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  33. ENDSEGMENT
  34. C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  35. C . ITYP,IFOUR,IFLUAG,
  36. C . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  37. C . JFLUAG,KFLUAG,LFLUAG,
  38. C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  39. C
  40. DATA ITMAX/200/
  41. C
  42. JEBOUC=0
  43. PENTEJ=PENTE
  44. DEPSJ=DEPS
  45. 2020 JEBOUC=JEBOUC+1
  46. PENTE=PENTEJ
  47. DEPS=DEPSJ
  48. IF(JEBOUC.GT.1) WRITE(6,77881) PENTE,DEPS
  49. 77881 FORMAT('0 VALEURS INITIALES PENTE=',1PE16.5,2X,
  50. . 'DEPS=',1PE16.5/)
  51. C
  52. C
  53. C CAS PLASTIQUE
  54. EPST=EPSTAR+DEPS
  55. C CONTRAINTE SUR LA COURBE DE TRACTION CORRESPONDANTE
  56. IF(ICINE.EQ.1) GO TO 81
  57. C CAS ISOTROPE
  58. CALL TRACTI(SN,EPST,SIG,EPS,NCOURB,2,IBI)
  59. IF(IBI.EQ.1) THEN
  60. KERRE=75
  61. GO TO 57
  62. ENDIF
  63. C
  64. C CAS MIXTE CALCUL DU NOUVEAU RAYON DE LA SPHERE
  65. IF(ICINE.EQ.2) SN=SN-PANTIN*EPST
  66. GO TO 82
  67. C CAS CINEMATIQUE
  68. 81 SN=SELAS
  69. 82 CONTINUE
  70. C CONTRAINTE MOYENNE
  71. SM=0.5*(SN+SELAS)
  72. C 2222 CONTINUE
  73. C
  74. C ITERATIONS INTERNES CALCUL DE DELTA EPSILON
  75. C
  76. ITER=0
  77. DEPS0=DEPS
  78. DEPSI=DEPS0
  79. SO=SN
  80. DEPS00=DEPS0
  81. JYCOMP=0
  82. UNSSM=1./SM
  83. SIGT(1)=SIGEL(1)+DSIGP(1)
  84. SI=SSTAR
  85. IF(JEBOUC.GT.1) WRITE(6,77882) SN,SM,SI
  86. 77882 FORMAT('0 SN =',1PE16.5,2X,'SM=',1PE16.5,2X,
  87. . 'SI=',1PE12.5/)
  88. 555 ITER=ITER+1
  89. IF(JEBOUC.GT.1) WRITE(6,77883) ITER
  90. 77883 FORMAT('0 -----> ITER=',I3/)
  91. DEPSI1=DEPSI
  92. SI1=SI
  93. STEST=TEST*SN
  94. Z=0.
  95. DO 52 IB=NK,IBOU
  96.  
  97. Y=UNSSM*E(IB)
  98. X=Y*DEPS
  99.  
  100. IF(X.EQ.0.) GO TO 51
  101. EXPMX=EXP(-X)
  102. UNSX=1./X
  103. UNSX2=UNSX*UNSX
  104. X2=X*X
  105. IF (ABS(X).LT.1.D-17) GO TO 50
  106. SIGT(IB)=(SIGEL(IB)-DSIGP(IB)*UNSX)*EXPMX+DSIGP(IB)*UNSX
  107. Z=Z+COEF(JKI+IB)*SIGT(IB)*(EXPMX*(DSIGP(IB)*UNSX2-SIGEL(IB)+
  108. 1DSIGP(IB)*UNSX)-DSIGP(IB)*UNSX2)*E(IB)
  109. GO TO 52
  110. 50 CONTINUE
  111. SIGT(IB)=SIGEL(IB)*(1.-X+0.5*X2)+DSIGP(IB)*(1-0.5*X)
  112. Z=Z+COEF(JKI+IB)*SIGT(IB)*E(IB)*(DSIGP(IB)*((X/3.)-0.5)-
  113. 1 SIGEL(IB)*(1-X+0.5*X2))
  114. GO TO 52
  115. C UNE VALEUR PROPRE EST NULLE
  116. 51 SIGT(IB)=SIGEL(IB)+DSIGP(IB)
  117. 52 CONTINUE
  118. C NOUVEL DEPS
  119. SI=VNMISD(SIGT,ITYP,ALFAH,CVNMSD)
  120. X=PENTE-Z*UNSSM/SI
  121. ZOB1 = UNSSM/SI
  122. ZOB2 = ZOB1 * Z
  123. IF(JEBOUC.GT.1) WRITE(6,77888) PENTE,Z,UNSSM
  124. 77888 FORMAT('0 PENTE =',1PE16.5,2X,'Z=',1PE16.5,2X,'UNSSM=',1PE16.5/)
  125. DEPSI=(SI-SN)/X
  126. DEPS=DEPS+DEPSI
  127. EPST=DEPS+EPSTAR
  128. IF(JEBOUC.GT.1) WRITE(6,77884) SI,SN,X,DEPSI,DEPS
  129. 77884 FORMAT('0 SI =',1PE16.5,2X,'SN=',1PE16.5,2X,
  130. .'X=',1PE16.5,2X, 'DEPSI=',1PE16.5,2X,'DEPS=',1PE16.5/)
  131. IF(ICINE.EQ.1) GO TO 580
  132. C ON CALCULE LA CONTRAINTE SUR LA COURBE DE TRACTION A
  133. C LA FIN DU PAS
  134. EPSTP=EPST
  135. C ON CONTROLE SI LE DEPS EST POSITIF
  136. C SI DEPS EST NEGATIF ON PREND EPSTP =EPST A L ITERATION PRECE
  137. IF(DEPS.LT.0.) EPSTP=EPSTP-DEPSI
  138. CALL TRACTI(SN,EPSTP,SIG,EPS,NCOURB,2,IBI)
  139. IF(IBI.EQ.1) THEN
  140. KERRE=75
  141. GO TO 57
  142. ENDIF
  143. C ON CALCULE LA PENTE A LA COURBE DE TRACTION A LA FIN DU PAS
  144. CALL TRACTI(PENTE1,EPSTP,SIG,EPS,NCOURB,1,IBI)
  145. IF(ICINE.EQ.2) SN=SN-EPST*PANTIN
  146. 580 CONTINUE
  147. IF(ITER.GE.ITMAX) GO TO 56
  148. C ON N A PAS DEPASSE LE NOMBRE MAX D ITERATIONS INTERNES
  149. IF(DEPS) 54,500,500
  150. C DEPS EST POSITIF
  151. 500 CONTINUE
  152. C ON PREND COMME NOUVELLE PENTE LA PENTE A LA FIN DU PAS
  153. IF(ABS(SI-SN)-STEST) 57,57,555
  154. C A T ON CONVERGE
  155. 56 SSTST=ABS(SI-SN)/SN
  156. KERRE=2
  157. write(6,fmt='('' kerre projvm'',i6)')kerre
  158. GO TO 57
  159. 54 CONTINUE
  160. C DEPS EST NEGATIF
  161. C LA PENTE A LA FIN DU PAS EST-ELLE SUPERIEURE A LA PENTE
  162. C AU DEBUT DANS LES CAS ISOTROPE ?
  163. IF(ICINE.EQ.1) GO TO 543
  164. C
  165. C MILL 26/3/93
  166. IF(PENTE.EQ.0.D0.AND.DEPS.LE.0.D0) GOTO 540
  167. C
  168. X=ABS(PENTE)
  169. IF(X.LT.ABS(PENTE1)) X=ABS(PENTE1)
  170. X=ABS((PENTE-PENTE1)/(X+1.D-10))
  171. IF(X.LT..2D00) GO TO 543
  172. C LA PENTE VARIE DE PLUS DE 20%
  173. C ON REGARDE SI LA COURBE EST CONCAVE
  174. IF(PENTE1.LT.PENTE) GO TO 543
  175. EPST=EPST-DEPS
  176. DEPS=DEPS-DEPSI
  177. C ON PREND PENTE =.5*(PENTE AU DEBUT + PENTE A LA FIN )
  178. PENTE=0.5D00*(PENTE+PENTE1)
  179. C ON CALCULE LE NOUVEAU DEPSI
  180. X=PENTE-Z*UNSSM/SI
  181. DEPSI=(SI-SN)/X
  182.  
  183. DEPS=DEPS+DEPSI
  184. IF(DEPS.GT.0.D00) GO TO 542
  185. C DEPS EST ENCORE NEGATIF
  186. GO TO 540
  187. 543 CONTINUE
  188. C LE POINT SI EST AU DESSUS DE LA SURFACE
  189. C ON RECOMMENCE AVEC LE PREMIER DEPS DIVISE PAR 2
  190. C LE POINT SI EST EN DESSOUS ON ASSIMILE LA TGT A LA CORDE
  191. EPST=EPST-DEPS
  192. DEPS=DEPS-DEPSI
  193. IF(SI.GT.SN) GO TO 540
  194. X=PENTE-(SI-SI1)/DEPSI1
  195. GO TO 541
  196. 540 CONTINUE
  197. IF(JYCOMP.GT.0) DEPS00=0.5*DEPS00
  198. JYCOMP=JYCOMP+1
  199. IF(JEBOUC.GT.1) WRITE(6,77887) JYCOMP
  200. 77887 FORMAT('0 JYCOMP = ',I4/)
  201. DEPS=0.5*DEPS00
  202. EPSOM=EPSTAR+DEPS
  203. DEPSI=DEPS
  204. CALL TRACTI(SN,EPSOM,SIG,EPS,NCOURB,2,IBI)
  205. IF(IBI.EQ.1) THEN
  206. KERRE=75
  207. GO TO 57
  208. ENDIF
  209. SM=0.5D00*(SN+SELAS)
  210. UNSSM=1.D00/SM
  211. GO TO 542
  212. 541 CONTINUE
  213. DEPSI=(SI-SN)/X
  214. DEPS=DEPS+DEPSI
  215. IF(DEPS.LE.0.D00) GO TO 540
  216. 542 CONTINUE
  217. EPST=EPSTAR+DEPS
  218. GO TO 555
  219. 57 CONTINUE
  220. IF( DEPS.LT.0.D0) THEN
  221. IF(JEBOUC.EQ.1) GO TO 2020
  222. ENDIF
  223. RETURN
  224. END
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  

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