Télécharger projvm.eso

Retour à la liste

Numérotation des lignes :

  1. C PROJVM SOURCE CB215821 15/02/13 21:15:18 8401
  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=',1PE12.5,2X,
  50. . 'DEPS=',1PE12.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 =',1PE12.5,2X,'SM=',1PE12.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. Y=UNSSM*E(IB)
  97. X=Y*DEPS
  98. IF(X.EQ.0.) GO TO 51
  99. EXPMX=EXP(-X)
  100. UNSX=1./X
  101. UNSX2=UNSX*UNSX
  102. X2=X*X
  103. IF (ABS(X).LT.0.01) GO TO 50
  104. SIGT(IB)=(SIGEL(IB)-DSIGP(IB)*UNSX)*EXPMX+DSIGP(IB)*UNSX
  105. Z=Z+COEF(JKI+IB)*SIGT(IB)*(EXPMX*(DSIGP(IB)*UNSX2-SIGEL(IB)+
  106. 1DSIGP(IB)*UNSX)-DSIGP(IB)*UNSX2)*E(IB)
  107. GO TO 52
  108. 50 CONTINUE
  109. SIGT(IB)=SIGEL(IB)*(1.-X+0.5*X2)+DSIGP(IB)*(1-0.5*X)
  110. Z=Z+COEF(JKI+IB)*SIGT(IB)*E(IB)*(DSIGP(IB)*(X*.333333-0.5)-
  111. 1 SIGEL(IB)*(1-X+0.5*X2))
  112. GO TO 52
  113. C UNE VALEUR PROPRE EST NULLE
  114. 51 SIGT(IB)=SIGEL(IB)+DSIGP(IB)
  115. 52 CONTINUE
  116. C NOUVEL DEPS
  117. SI=VNMISD(SIGT,ITYP,ALFAH,CVNMSD)
  118. X=PENTE-Z*UNSSM/SI
  119. ZOB1 = UNSSM/SI
  120. ZOB2 = ZOB1 * Z
  121. IF(JEBOUC.GT.1) WRITE(6,77888) PENTE,Z,UNSSM
  122. 77888 FORMAT('0 PENTE =',1PE12.5,2X,'Z=',1PE12.5,2X,'UNSSM=',1PE12.5/)
  123. DEPSI=(SI-SN)/X
  124. DEPS=DEPS+DEPSI
  125. EPST=DEPS+EPSTAR
  126. IF(JEBOUC.GT.1) WRITE(6,77884) SI,SN,X,DEPSI,DEPS
  127. 77884 FORMAT('0 SI =',1PE12.5,2X,'SN=',1PE12.5,2X,'X=',1PE12.5,2X,
  128. . 'DEPSI=',1PE12.5,2X,'DEPS=',1PE12.5/)
  129. IF(ICINE.EQ.1) GO TO 580
  130. C ON CALCULE LA CONTRAINTE SUR LA COURBE DE TRACTION A
  131. C LA FIN DU PAS
  132. EPSTP=EPST
  133. C ON CONTROLE SI LE DEPS EST POSITIF
  134. C SI DEPS EST NEGATIF ON PREND EPSTP =EPST A L ITERATION PRECE
  135. IF(DEPS.LT.0.) EPSTP=EPSTP-DEPSI
  136. CALL TRACTI(SN,EPSTP,SIG,EPS,NCOURB,2,IBI)
  137. IF(IBI.EQ.1) THEN
  138. KERRE=75
  139. GO TO 57
  140. ENDIF
  141. C ON CALCULE LA PENTE A LA COURBE DE TRACTION A LA FIN DU PAS
  142. CALL TRACTI(PENTE1,EPSTP,SIG,EPS,NCOURB,1,IBI)
  143. IF(ICINE.EQ.2) SN=SN-EPST*PANTIN
  144. 580 CONTINUE
  145. IF(ITER.GE.ITMAX) GO TO 56
  146. C ON N A PAS DEPASSE LE NOMBRE MAX D ITERATIONS INTERNES
  147. IF(DEPS) 54,500,500
  148. C DEPS EST POSITIF
  149. 500 CONTINUE
  150. C ON PREND COMME NOUVELLE PENTE LA PENTE A LA FIN DU PAS
  151. IF(ABS(SI-SN)-STEST) 57,57,555
  152. C A T ON CONVERGE
  153. 56 SSTST=ABS(SI-SN)/SN
  154. KERRE=2
  155. write(6,fmt='('' kerre projvm'',i6)')kerre
  156. GO TO 57
  157. 54 CONTINUE
  158. C DEPS EST NEGATIF
  159. C LA PENTE A LA FIN DU PAS EST-ELLE SUPERIEURE A LA PENTE
  160. C AU DEBUT DANS LES CAS ISOTROPE ?
  161. IF(ICINE.EQ.1) GO TO 543
  162. C
  163. C MILL 26/3/93
  164. IF(PENTE.EQ.0.D0.AND.DEPS.LE.0.D0) GOTO 540
  165. C
  166. X=ABS(PENTE)
  167. IF(X.LT.ABS(PENTE1)) X=ABS(PENTE1)
  168. X=ABS((PENTE-PENTE1)/(X+1.D-10))
  169. IF(X.LT..2D00) GO TO 543
  170. C LA PENTE VARIE DE PLUS DE 20%
  171. C ON REGARDE SI LA COURBE EST CONCAVE
  172. IF(PENTE1.LT.PENTE) GO TO 543
  173. EPST=EPST-DEPS
  174. DEPS=DEPS-DEPSI
  175. C ON PREND PENTE =.5*(PENTE AU DEBUT + PENTE A LA FIN )
  176. PENTE=0.5D00*(PENTE+PENTE1)
  177. C ON CALCULE LE NOUVEAU DEPSI
  178. X=PENTE-Z*UNSSM/SI
  179. DEPSI=(SI-SN)/X
  180. DEPS=DEPS+DEPSI
  181. IF(DEPS.GT.0.D00) GO TO 542
  182. C DEPS EST ENCORE NEGATIF
  183. GO TO 540
  184. 543 CONTINUE
  185. C LE POINT SI EST AU DESSUS DE LA SURFACE
  186. C ON RECOMMENCE AVEC LE PREMIER DEPS DIVISE PAR 2
  187. C LE POINT SI EST EN DESSOUS ON ASSIMILE LA TGT A LA CORDE
  188. EPST=EPST-DEPS
  189. DEPS=DEPS-DEPSI
  190. IF(SI.GT.SN) GO TO 540
  191. X=PENTE-(SI-SI1)/DEPSI1
  192. GO TO 541
  193. 540 CONTINUE
  194. IF(JYCOMP.GT.0) DEPS00=0.5*DEPS00
  195. JYCOMP=JYCOMP+1
  196. IF(JEBOUC.GT.1) WRITE(6,77887) JYCOMP
  197. 77887 FORMAT('0 JYCOMP = ',I4/)
  198. DEPS=0.5*DEPS00
  199. EPSOM=EPSTAR+DEPS
  200. DEPSI=DEPS
  201. CALL TRACTI(SN,EPSOM,SIG,EPS,NCOURB,2,IBI)
  202. IF(IBI.EQ.1) THEN
  203. KERRE=75
  204. GO TO 57
  205. ENDIF
  206. SM=0.5D00*(SN+SELAS)
  207. UNSSM=1.D00/SM
  208. GO TO 542
  209. 541 CONTINUE
  210. DEPSI=(SI-SN)/X
  211. DEPS=DEPS+DEPSI
  212. IF(DEPS.LE.0.D00) GO TO 540
  213. 542 CONTINUE
  214. EPST=EPSTAR+DEPS
  215. GO TO 555
  216. 57 CONTINUE
  217. IF( DEPS.LT.0.D0) THEN
  218. IF(JEBOUC.EQ.1) GO TO 2020
  219. ENDIF
  220. RETURN
  221. END
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  

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