Download infich.eso

Back to the list

   1 : C INFICH    SOURCE    PV        08/09/11    21:16:04     6150           
   2 : C INFICH     SOURCE    AMAND       00/03/27       
   3 :       SUBROUTINE INFICH(CODU,CODL,COD,BETJEF,BETFLU)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z) 
   6 :       DIMENSION CODU(9,9),CODL(8,8),COD(8),FL1(89),FL2(72)
   7 : C     
   8 :       SEGMENT BETJEF
   9 :        REAL*8 AA,BETA,RB,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
  10 :      &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  11 :        INTEGER ICT,ICC,IMOD,IVIS,ITER,
  12 :      &                ISIM,IBB,IGAU1,IZON
  13 :       ENDSEGMENT
  14 :       SEGMENT BETFLU
  15 :        REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  16 :      &         TP0,TZER
  17 :        INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
  18 :       ENDSEGMENT
  19 : C
  20 : C CE PROGRAMME SAUVEGARDE LES DONNEES DE RESOLUTION DES COEFFICIENTS DE MAXWELL 
  21 : C IL PERMET EGALEMENT LA RESTITUTION DE CEUX-CI POUR UTILISATION
  22 : C
  23 : C--------------------------------
  24 : C INITIALISATION
  25 : C--------------------------------
  26 :       IF (TP0.EQ.0.D0) THEN
  27 :         ITEST = 0
  28 :       ELSE
  29 :         ITEST = 1
  30 :       ENDIF
  31 : C   
  32 :       IF (IGAU1.EQ.1.AND.IBB.EQ.1.AND.ITEST.EQ.0) THEN
  33 : C
  34 :       IF (IFOR.EQ.1) THEN
  35 :       DO 1 I = 1,89
  36 :         FL1(I) = 0.D0
  37 :     1 CONTINUE
  38 :       ELSE IF (IFOR.EQ.2) THEN
  39 :       DO 2 I = 1,72
  40 :         FL2(I) = 0.D0
  41 :     2 CONTINUE
  42 :       ENDIF
  43 : C       
  44 : C 
  45 : C--------------------------------
  46 : C ECRITURE
  47 : C--------------------------------
  48 : C 
  49 :       IF (IFOR.EQ.1) THEN
  50 : C
  51 :       M = 0  
  52 :       DO 5 I = 1,89
  53 :         IF (FL1(I).EQ.0.D0) THEN
  54 :         M = M + 1
  55 :         ENDIF
  56 :     5 CONTINUE
  57 : C    
  58 :       IF (M.EQ.89) THEN
  59 : C      
  60 :       K = 0
  61 :       J = 1
  61 :       CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
  62 : C      
  63 :       DO 10 I = 1,81
  64 :         IF (K.EQ.9) THEN
  65 :         J= J + 1
  66 :         K = 0
  67 :         ENDIF
  68 :         K = K + 1
  69 :            FL1(I) = CODU(J,K)   
  70 :    10 CONTINUE
  71 :       DO 11 I = 82,89
  72 :         N = I - 81
  73 :            FL1(I) = COD(N)      
  74 :    11 CONTINUE
  75 : C
  76 :    90 FORMAT (E20.5)  
  77 :       OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
  78 :       WRITE(9,90) (FL1(I), I = 1,89)
  79 :       ENDFILE 9
  80 : C
  81 :       ENDIF
  82 :       ENDIF
  83 : C
  84 :       IF (IFOR.EQ.2) THEN
  85 : C
  86 :       M = 0  
  87 :       DO 6 I = 1,72
  88 :         IF (FL2(I).EQ.0.D0) THEN
  89 :         M = M + 1
  90 :         ENDIF
  91 :     6 CONTINUE
  92 : C    
  93 :       IF (M.EQ.72) THEN
  94 : C      
  95 :       K = 0
  96 :       J = 1
  96 :       CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
  97 : C      
  98 :       DO 12 I = 1,64
  99 :         IF (K.EQ.8) THEN
 100 :         J= J + 1
 101 :         K = 0
 102 :         ENDIF
 103 :         K = K + 1
 104 :            FL2(I) = CODL(J,K)   
 105 :    12 CONTINUE
 106 :       DO 13 I = 65,72
 107 :         N = I - 64
 108 :            FL2(I) = COD(N)      
 109 :    13 CONTINUE
 110 : C
 111 :       OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
 112 :       WRITE(9,90) (FL2(I), I = 1,72)
 113 :       ENDFILE 9
 114 : C
 115 :       ENDIF
 116 :       ENDIF
 117 : C
 118 : C--------------------------------
 119 : C LECTURE
 120 : C--------------------------------
 121 : C 
 122 :       ELSE
 123 : C
 124 :       IF (IFOR.EQ.1) THEN
 125 :       K = 0
 126 :       J = 1
 127 :       REWIND 9
 128 :       OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
 129 :       READ(9,90) (FL1(I), I = 1,89)      
 130 :       DO 20 I = 1,81
 131 :         IF (K.EQ.9) THEN
 132 :         J= J + 1
 133 :         K = 0
 134 :         ENDIF
 135 :         K = K + 1
 136 :            CODU(J,K) = FL1(I)   
 137 :    20 CONTINUE  
 138 :       DO 21 I = 82,89
 139 :         N = I - 81
 140 :         COD(N) = 0.D0
 141 :            COD(N) = FL1(I)
 142 :    21 CONTINUE
 142 :       CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
 143 : C
 144 :       ENDIF
 145 : C
 146 :       IF (IFOR.EQ.2) THEN
 147 :       K = 0
 148 :       J = 1
 149 :       REWIND 9
 150 :       OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
 151 :       READ(9,90) (FL1(I), I = 1,72)      
 152 :       DO 22 I = 1,64
 153 :         IF (K.EQ.8) THEN
 154 :         J= J + 1
 155 :         K = 0
 156 :         ENDIF
 157 :         K = K + 1
 158 :            CODL(J,K) = FL2(I)   
 159 :    22 CONTINUE  
 160 :       DO 23 I = 65,72
 161 :         N = I - 64
 162 :            COD(N) = 0.D0
 163 :            COD(N) = FL2(I)
 164 :    23 CONTINUE
 164 :       CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
 165 : C
 166 :       ENDIF
 167 :       ENDIF
 168 :       CLOSE (9)
 169 : C
 170 : C--------------------------------
 171 : C FIN
 172 : C--------------------------------
 173 : C
 174 :       RETURN
 175 :       END       
 176 :  
 177 :  
 178 :  

© Cast3M 2003 - All rights reserved.
Disclaimer