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