Télécharger infich.eso

Retour à la liste

infich
C INFICH    SOURCE    PV        08/09/11    21:16:04     6150
C INFICH     SOURCE    AMAND       00/03/27
      SUBROUTINE INFICH(CODU,CODL,COD,BETJEF,BETFLU)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION CODU(9,9),CODL(8,8),COD(8),FL1(89),FL2(72)
C
      SEGMENT BETJEF
       REAL*8 AA,BETA,RB,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
     &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
       INTEGER ICT,ICC,IMOD,IVIS,ITER,
     &                ISIM,IBB,IGAU1,IZON
      ENDSEGMENT
      SEGMENT BETFLU
       REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
     &         TP0,TZER
       INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
      ENDSEGMENT
C
C CE PROGRAMME SAUVEGARDE LES DONNEES DE RESOLUTION DES COEFFICIENTS DE MAXWELL
C IL PERMET EGALEMENT LA RESTITUTION DE CEUX-CI POUR UTILISATION
C
C--------------------------------
C INITIALISATION
C--------------------------------
      IF (TP0.EQ.0.D0) THEN
        ITEST = 0
      ELSE
        ITEST = 1
      ENDIF
C
      IF (IGAU1.EQ.1.AND.IBB.EQ.1.AND.ITEST.EQ.0) THEN
C
      IF (IFOR.EQ.1) THEN
      DO 1 I = 1,89
        FL1(I) = 0.D0
    1 CONTINUE
      ELSE IF (IFOR.EQ.2) THEN
      DO 2 I = 1,72
        FL2(I) = 0.D0
    2 CONTINUE
      ENDIF
C
C
C--------------------------------
C ECRITURE
C--------------------------------
C
      IF (IFOR.EQ.1) THEN
C
      M = 0
      DO 5 I = 1,89
        IF (FL1(I).EQ.0.D0) THEN
        M = M + 1
        ENDIF
    5 CONTINUE
C
      IF (M.EQ.89) THEN
C
      K = 0
      J = 1
      CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
C
      DO 10 I = 1,81
        IF (K.EQ.9) THEN
        J= J + 1
        K = 0
        ENDIF
        K = K + 1
           FL1(I) = CODU(J,K)
   10 CONTINUE
      DO 11 I = 82,89
        N = I - 81
           FL1(I) = COD(N)
   11 CONTINUE
C
   90 FORMAT (E20.5)
      OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
      WRITE(9,90) (FL1(I), I = 1,89)
      ENDFILE 9
C
      ENDIF
      ENDIF
C
      IF (IFOR.EQ.2) THEN
C
      M = 0
      DO 6 I = 1,72
        IF (FL2(I).EQ.0.D0) THEN
        M = M + 1
        ENDIF
    6 CONTINUE
C
      IF (M.EQ.72) THEN
C
      K = 0
      J = 1
      CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
C
      DO 12 I = 1,64
        IF (K.EQ.8) THEN
        J= J + 1
        K = 0
        ENDIF
        K = K + 1
           FL2(I) = CODL(J,K)
   12 CONTINUE
      DO 13 I = 65,72
        N = I - 64
           FL2(I) = COD(N)
   13 CONTINUE
C
      OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
      WRITE(9,90) (FL2(I), I = 1,72)
      ENDFILE 9
C
      ENDIF
      ENDIF
C
C--------------------------------
C LECTURE
C--------------------------------
C
      ELSE
C
      IF (IFOR.EQ.1) THEN
      K = 0
      J = 1
      REWIND 9
      OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
      READ(9,90) (FL1(I), I = 1,89)
      DO 20 I = 1,81
        IF (K.EQ.9) THEN
        J= J + 1
        K = 0
        ENDIF
        K = K + 1
           CODU(J,K) = FL1(I)
   20 CONTINUE
      DO 21 I = 82,89
        N = I - 81
        COD(N) = 0.D0
           COD(N) = FL1(I)
   21 CONTINUE
      CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
C
      ENDIF
C
      IF (IFOR.EQ.2) THEN
      K = 0
      J = 1
      REWIND 9
      OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
      READ(9,90) (FL1(I), I = 1,72)
      DO 22 I = 1,64
        IF (K.EQ.8) THEN
        J= J + 1
        K = 0
        ENDIF
        K = K + 1
           CODL(J,K) = FL2(I)
   22 CONTINUE
      DO 23 I = 65,72
        N = I - 64
           COD(N) = 0.D0
           COD(N) = FL2(I)
   23 CONTINUE
      CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
C
      ENDIF
      ENDIF
      CLOSE (9)
C
C--------------------------------
C FIN
C--------------------------------
C
      RETURN
      END
 
 
 
 

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