Télécharger stocm.eso

Retour à la liste

Numérotation des lignes :

  1. C STOCM SOURCE STRU 06/12/14 21:15:30 5611
  2. c Sous-Programme du module MISTRAL1
  3. C --------------------------------------------------------------------------
  4. SUBROUTINE STOCM (T, TT,FI,FIT, PSI,
  5. & SIG, VEPS, EPS,EPSTH,EPSEL,EPSCR,
  6. & SEQ,RR, VEPSE,EPSEQP,VEPSP, EPSE,EPSEQ,EPSP,
  7. & XX, NDPI,NDVP,NXX, FICH,IUM)
  8. C --------------------------------------------------------------------------
  9. C Stockage des valeurs a l'instant T sur des fichiers dont les noms
  10. C commencent par FICH :
  11. C - valeurs globales sur le fichier FICHM associe au canal IUM,
  12. C - valeurs relatives aux deformations plastiques IDP sur les fichiers
  13. C FICHP(IDP) associes aux NDPI+NDVP canaux suivants,
  14. C - contraintes internes IXX sur les fichiers FICHX(IXX)
  15. C associes aux NXX canaux suivants.
  16. C --------------------------------------------------------------------------
  17. IMPLICIT INTEGER (I-N)
  18. IMPLICIT REAL*8 (A-H, O-Z)
  19. c std :
  20. PARAMETER ( NDVPMA = 4 , NXXMAX = 3 )
  21. c std.
  22. DIMENSION SIG(1:*),VEPS(1:*)
  23. DIMENSION EPS(1:*),EPSTH(1:*),EPSEL(1:*),EPSCR(1:*)
  24. DIMENSION SEQ(0:*),RR(0:*),VEPSE(0:*),EPSEQP(0:*),VEPSP(1:6,0:*),
  25. & EPSE(0:*),EPSEQ(0:*),EPSP(1:6,0:*)
  26. DIMENSION XX(1:6,1:*)
  27. CHARACTER *(*) FICH
  28. c std :
  29. CHARACTER *74 FICHM,FICHP(0:NDVPMA),FICHX(1:NXXMAX)
  30. c std.
  31. IF (T.EQ.0.) THEN
  32. FICHM = FICH(1:INDEX(FICH,' ')-1)//'_M'
  33. OPEN (UNIT=IUM,FILE=FICHM)
  34. WRITE (IUM,1)
  35. 1 FORMAT (9X,' T ',16X,' TT ',
  36. & 16X,' FI ',16X,' FIT ',16X,' PSI ',
  37. & 16X,' SIG11 ',16X,' SIG22 ',16X,' SIG33 ',
  38. & 16X,' SIG12 ',16X,' SIG13 ',16X,' SIG23 ',
  39. & 16X,' VEPS11 ',16X,' VEPS22 ',16X,' VEPS33 ',
  40. & 16X,' VEPS12 ',16X,' VEPS13 ',16X,' VEPS23 ',
  41. & 16X,' EPS11 ',16X,' EPS22 ',16X,' EPS33 ',
  42. & 16X,' EPS12 ',16X,' EPS13 ',16X,' EPS23 ',
  43. & 16X,' EPSTH11',16X,' EPSTH22',16X,' EPSTH33',
  44. & 16X,' EPSTH12',16X,' EPSTH13',16X,' EPSTH23',
  45. & 16X,' EPSEL11',16X,' EPSEL22',16X,' EPSEL33',
  46. & 16X,' EPSEL12',16X,' EPSEL13',16X,' EPSEL23',
  47. & 16X,' EPSCR11',16X,' EPSCR22',16X,' EPSCR33',
  48. & 16X,' EPSCR12',16X,' EPSCR13',16X,' EPSCR23',/)
  49. END IF
  50. WRITE (IUM,10) T,TT,FI,FIT,PSI,(SIG(IJ),IJ=1,6),
  51. & (VEPS(IJ),IJ=1,6),(EPS(IJ),IJ=1,6),
  52. & (EPSTH(IJ),IJ=1,6),(EPSEL(IJ),IJ=1,6),
  53. & (EPSCR(IJ),IJ=1,6)
  54. IUP = IUM
  55. DO IDP = 1-NDPI,NDVP
  56. IUP = IUP+1
  57. IF (T.EQ.0.) THEN
  58. FICHP(IDP) = FICH(1:INDEX(FICH,' ')-1)//'_p'//CHAR(IDP+48)
  59. OPEN (UNIT=IUP,FILE=FICHP(IDP))
  60. WRITE (IUP,2)
  61. 2 FORMAT (9X,' T ',16X,' SEQ ',16X,' RR ',
  62. & 16X,' VEPSE ',16X,' EPSEQP ',
  63. & 16X,'VEPSP11 ',16X,'VEPSP22 ',16X,'VEPSP33 ',
  64. & 16X,'VEPSP12 ',16X,'VEPSP13 ',16X,'VEPSP23 ',
  65. & 16X,' EPSE ',16X,' EPSEQ ',
  66. & 16X,' EPSP11 ',16X,' EPSP22 ',16X,' EPSP33 ',
  67. & 16X,' EPSP12 ',16X,' EPSP13 ',16X,' EPSP23 ',/)
  68. END IF
  69. WRITE (IUP,10) T,SEQ(IDP),RR(IDP),VEPSE(IDP),EPSEQP(IDP),
  70. & (VEPSP(IJ,IDP),IJ=1,6),EPSE(IDP),EPSEQ(IDP),
  71. & (EPSP(IJ,IDP),IJ=1,6)
  72. END DO
  73. IUX = IUP
  74. DO IXX = 1,NXX
  75. IUX = IUX+1
  76. IF (T.EQ.0.) THEN
  77. FICHX(IXX) = FICH(1:INDEX(FICH,' ')-1)//'_X'//CHAR(IXX+48)
  78. OPEN (UNIT=IUX,FILE=FICHX(IXX))
  79. WRITE (IUX,3)
  80. 3 FORMAT (9X,' T ',
  81. & 16X,' XX11 ',16X,' XX22 ',16X,' XX33 ',
  82. & 16X,' XX12 ',16X,' XX13 ',16X,' XX23 ',/)
  83. END IF
  84. WRITE (IUX,10) T,(XX(IJ,IXX),IJ=1,6)
  85. END DO
  86. RETURN
  87. 10 FORMAT (1X,41(2X,G22.15))
  88. END
  89.  
  90.  

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