Sources Esope | Cast3M

stocm
C STOCM     SOURCE    STRU      06/12/14    21:15:30     5611
c     Sous-Programme du module MISTRAL1
C     --------------------------------------------------------------------------
      SUBROUTINE STOCM (T, TT,FI,FIT, PSI,
     &                  SIG, VEPS, EPS,EPSTH,EPSEL,EPSCR,
     &                  SEQ,RR, VEPSE,EPSEQP,VEPSP, EPSE,EPSEQ,EPSP,
     &                  XX, NDPI,NDVP,NXX, FICH,IUM)
C     --------------------------------------------------------------------------
C     Stockage des valeurs a l'instant T sur des fichiers dont les noms
C     commencent par FICH :
C     - valeurs globales sur le fichier FICHM associe au canal IUM,
C     - valeurs relatives aux deformations plastiques IDP sur les fichiers
C       FICHP(IDP) associes aux NDPI+NDVP canaux suivants,
C     - contraintes internes IXX sur les fichiers FICHX(IXX)
C       associes aux NXX canaux suivants.
C     --------------------------------------------------------------------------
      IMPLICIT INTEGER (I-N)
        IMPLICIT REAL*8 (A-H, O-Z)
c     std :
      PARAMETER ( NDVPMA = 4 , NXXMAX = 3 )
c     std.
      DIMENSION SIG(1:*),VEPS(1:*)
      DIMENSION EPS(1:*),EPSTH(1:*),EPSEL(1:*),EPSCR(1:*)
      DIMENSION SEQ(0:*),RR(0:*),VEPSE(0:*),EPSEQP(0:*),VEPSP(1:6,0:*),
     &          EPSE(0:*),EPSEQ(0:*),EPSP(1:6,0:*)
      DIMENSION XX(1:6,1:*)
      CHARACTER *(*) FICH
c     std :
      CHARACTER *74 FICHM,FICHP(0:NDVPMA),FICHX(1:NXXMAX)
c     std.
        IF (T.EQ.0.) THEN
       FICHM = FICH(1:INDEX(FICH,'  ')-1)//'_M'
         OPEN (UNIT=IUM,FILE=FICHM)
         WRITE (IUM,1)
1        FORMAT (9X,'   T    ',16X,'   TT   ',
     &        16X,'   FI   ',16X,'  FIT   ',16X,'  PSI   ',
     &        16X,' SIG11  ',16X,' SIG22  ',16X,' SIG33  ',
     &        16X,' SIG12  ',16X,' SIG13  ',16X,' SIG23  ',
     &        16X,' VEPS11 ',16X,' VEPS22 ',16X,' VEPS33 ',
     &        16X,' VEPS12 ',16X,' VEPS13 ',16X,' VEPS23 ',
     &        16X,'  EPS11 ',16X,'  EPS22 ',16X,'  EPS33 ',
     &        16X,'  EPS12 ',16X,'  EPS13 ',16X,'  EPS23 ',
     &        16X,' EPSTH11',16X,' EPSTH22',16X,' EPSTH33',
     &        16X,' EPSTH12',16X,' EPSTH13',16X,' EPSTH23',
     &        16X,' EPSEL11',16X,' EPSEL22',16X,' EPSEL33',
     &        16X,' EPSEL12',16X,' EPSEL13',16X,' EPSEL23',
     &        16X,' EPSCR11',16X,' EPSCR22',16X,' EPSCR33',
     &        16X,' EPSCR12',16X,' EPSCR13',16X,' EPSCR23',/)
        END IF
        WRITE (IUM,10) T,TT,FI,FIT,PSI,(SIG(IJ),IJ=1,6),
     &             (VEPS(IJ),IJ=1,6),(EPS(IJ),IJ=1,6),
     &             (EPSTH(IJ),IJ=1,6),(EPSEL(IJ),IJ=1,6),
     &             (EPSCR(IJ),IJ=1,6)
      IUP = IUM
      DO IDP = 1-NDPI,NDVP
         IUP = IUP+1
         IF (T.EQ.0.) THEN
        FICHP(IDP) = FICH(1:INDEX(FICH,'  ')-1)//'_p'//CHAR(IDP+48)
          OPEN (UNIT=IUP,FILE=FICHP(IDP))
          WRITE (IUP,2)
2         FORMAT (9X,'   T    ',16X,'  SEQ   ',16X,'   RR   ',
     &         16X,' VEPSE  ',16X,' EPSEQP ',
     &         16X,'VEPSP11 ',16X,'VEPSP22 ',16X,'VEPSP33 ',
     &         16X,'VEPSP12 ',16X,'VEPSP13 ',16X,'VEPSP23 ',
     &         16X,'  EPSE  ',16X,' EPSEQ  ',
     &         16X,' EPSP11 ',16X,' EPSP22 ',16X,' EPSP33 ',
     &         16X,' EPSP12 ',16X,' EPSP13 ',16X,' EPSP23 ',/)
         END IF
         WRITE (IUP,10) T,SEQ(IDP),RR(IDP),VEPSE(IDP),EPSEQP(IDP),
     &               (VEPSP(IJ,IDP),IJ=1,6),EPSE(IDP),EPSEQ(IDP),
     &               (EPSP(IJ,IDP),IJ=1,6)
      END DO
      IUX = IUP
      DO IXX = 1,NXX
         IUX = IUX+1
         IF (T.EQ.0.) THEN
        FICHX(IXX) = FICH(1:INDEX(FICH,'  ')-1)//'_X'//CHAR(IXX+48)
          OPEN (UNIT=IUX,FILE=FICHX(IXX))
          WRITE (IUX,3)
3         FORMAT (9X,'   T    ',
     &         16X,'  XX11  ',16X,'  XX22  ',16X,'  XX33  ',
     &         16X,'  XX12  ',16X,'  XX13  ',16X,'  XX23  ',/)
         END IF
         WRITE (IUX,10) T,(XX(IJ,IXX),IJ=1,6)
      END DO
        RETURN
10    FORMAT (1X,41(2X,G22.15))
        END