Télécharger infich.eso

Retour à la liste

Numérotation des lignes :

infich
  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
  62. CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
  63. C
  64. DO 10 I = 1,81
  65. IF (K.EQ.9) THEN
  66. J= J + 1
  67. K = 0
  68. ENDIF
  69. K = K + 1
  70. FL1(I) = CODU(J,K)
  71. 10 CONTINUE
  72. DO 11 I = 82,89
  73. N = I - 81
  74. FL1(I) = COD(N)
  75. 11 CONTINUE
  76. C
  77. 90 FORMAT (E20.5)
  78. OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
  79. WRITE(9,90) (FL1(I), I = 1,89)
  80. ENDFILE 9
  81. C
  82. ENDIF
  83. ENDIF
  84. C
  85. IF (IFOR.EQ.2) THEN
  86. C
  87. M = 0
  88. DO 6 I = 1,72
  89. IF (FL2(I).EQ.0.D0) THEN
  90. M = M + 1
  91. ENDIF
  92. 6 CONTINUE
  93. C
  94. IF (M.EQ.72) THEN
  95. C
  96. K = 0
  97. J = 1
  98. CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
  99. C
  100. DO 12 I = 1,64
  101. IF (K.EQ.8) THEN
  102. J= J + 1
  103. K = 0
  104. ENDIF
  105. K = K + 1
  106. FL2(I) = CODL(J,K)
  107. 12 CONTINUE
  108. DO 13 I = 65,72
  109. N = I - 64
  110. FL2(I) = COD(N)
  111. 13 CONTINUE
  112. C
  113. OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
  114. WRITE(9,90) (FL2(I), I = 1,72)
  115. ENDFILE 9
  116. C
  117. ENDIF
  118. ENDIF
  119. C
  120. C--------------------------------
  121. C LECTURE
  122. C--------------------------------
  123. C
  124. ELSE
  125. C
  126. IF (IFOR.EQ.1) THEN
  127. K = 0
  128. J = 1
  129. REWIND 9
  130. OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
  131. READ(9,90) (FL1(I), I = 1,89)
  132. DO 20 I = 1,81
  133. IF (K.EQ.9) THEN
  134. J= J + 1
  135. K = 0
  136. ENDIF
  137. K = K + 1
  138. CODU(J,K) = FL1(I)
  139. 20 CONTINUE
  140. DO 21 I = 82,89
  141. N = I - 81
  142. COD(N) = 0.D0
  143. COD(N) = FL1(I)
  144. 21 CONTINUE
  145. CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
  146. C
  147. ENDIF
  148. C
  149. IF (IFOR.EQ.2) THEN
  150. K = 0
  151. J = 1
  152. REWIND 9
  153. OPEN (UNIT = 9,FILE = 'CREEP', STATUS = 'UNKNOWN')
  154. READ(9,90) (FL1(I), I = 1,72)
  155. DO 22 I = 1,64
  156. IF (K.EQ.8) THEN
  157. J= J + 1
  158. K = 0
  159. ENDIF
  160. K = K + 1
  161. CODL(J,K) = FL2(I)
  162. 22 CONTINUE
  163. DO 23 I = 65,72
  164. N = I - 64
  165. COD(N) = 0.D0
  166. COD(N) = FL2(I)
  167. 23 CONTINUE
  168. CALL TYPFLU (CODU,CODL,COD,BETJEF,BETFLU)
  169. C
  170. ENDIF
  171. ENDIF
  172. CLOSE (9)
  173. C
  174. C--------------------------------
  175. C FIN
  176. C--------------------------------
  177. C
  178. RETURN
  179. END
  180.  
  181.  
  182.  
  183.  

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