Télécharger visavi.eso

Retour à la liste

Numérotation des lignes :

  1. C VISAVI SOURCE BP208322 09/03/25 21:16:09 6343
  2. SUBROUTINE VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL,
  3. .SIGF,DEFP,VARINF,SIGFIN,DEFPLA,DSIGZE,ICENT2,MCOD,IBOU,MFR,
  4. .NSTRS,CARAC,CMATE,ecou,necou)
  5. c--------------------------------------------------------------------
  6. c correspondance ca2000 - inca
  7. c--------------------------------------------------------------------
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. DIMENSION SIG0(*),DSIGT(*),VARIN0(*),SIGF(*),DEFP(*),VARINF(*),
  11. . SIGMA(*),DSIGMA(*),SPHER(*),AUXIL(*),DSIGZE(*),SIGFIN(*),
  12. . DEFPLA(*),CARAC(*)
  13. c
  14. c mcod = 1 correspondance en entree
  15. c mcod = 2 correspondance en sortie
  16. c
  17. SEGMENT ECOU
  18. *** COMMON/ECOU/TEST,ALFAH,
  19. REAL*8 TEST, ALFAH,
  20. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  21. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  22. 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  23. 2 SIPLAD(6),DSIGP0(6),TET,TETI
  24. ENDSEGMENT
  25. C COMMON/ECOU/TEST,ALFAH,
  26. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  27. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  28. C 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  29. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  30. c
  31. SEGMENT NECOU
  32. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  33. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  34. . ITYP,IFOUR,IFLUAG,
  35. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  36. . JFLUAG,KFLUAG,LFLUAG,
  37. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  38. ENDSEGMENT
  39. C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  40. C . ITYP,IFOUR,IFLUAG,
  41. C . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  42. C . JFLUAG,KFLUAG,LFLUAG,
  43. C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  44. *
  45. CHARACTER*8 CMATE
  46. *
  47.  
  48. DIMENSION NNN(14)
  49. DATA NNN / 6,6,3,3,6,4,6,1,6,3,6,6,6,3 /
  50.  
  51. * GO TO (9001,9002),MCOD
  52. c
  53. * 9001 CONTINUE
  54. c----------------------------------------------------------------------
  55. c correspondance ( mfr,ifour) et ityp
  56. czzzz a completer
  57. c----------------------------------------------------------------------
  58. c IF (MFR.EQ.1.OR.MFR.EQ.31) THEN
  59. c as :
  60. IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63) THEN
  61. IF (IFOUR.EQ.-2) ITYP=6
  62. IF (IFOUR.EQ.-3) ITYP=1
  63. IF (IFOUR.GE.-1.AND.IFOUR.LE.2) ITYP=1
  64. IF (IFOUR.GE.3.AND.IFOUR.LE.15) ITYP=14
  65. ENDIF
  66. *
  67. * test en cas de materiau unidirectionnel
  68. *
  69. IF(CMATE.EQ.'UNIDIREC'.AND.
  70. $ MFR.EQ.1) ITYP=8
  71. IF(MFR.EQ.33.AND.IFOUR.EQ.-2) ITYP=6
  72. IF(MFR.EQ.33.AND.IFOUR.GE.-1) ITYP=1
  73. IF(MFR.EQ.3.AND.IFOUR.NE.-2) ITYP=2
  74. IF(MFR.EQ.3.AND.IFOUR.EQ.-2) ITYP=7
  75. IF(MFR.EQ.5) ITYP=13
  76. IF(MFR.EQ.7) ITYP=11
  77. IF(MFR.EQ.9) ITYP= 2
  78. c cas du coq4 : on ne travaille que sur les 6-eres composantes
  79. IF(MFR.EQ.13) ITYP=12
  80. IF(MFR.EQ.25) ITYP=3
  81. IF(MFR.EQ.27.OR.MFR.EQ.49) ITYP=4
  82. c--------------------------------------------------------------------
  83. c on commence par tout mettre a 0.
  84. c--------------------------------------------------------------------
  85. IF(ITYP.EQ.0) RETURN
  86. IBOU=NNN(ITYP)
  87. IBM=NSTRS
  88. IF(MFR.EQ.9.AND.IFOUR.GT.0) IBM=IBOU
  89.  
  90.  
  91. GO TO (9001,9002),MCOD
  92. c
  93. 9001 CONTINUE
  94. c
  95. DO 8816 IB=1,IBOU
  96. IF(IRELAX.NE.0) THEN
  97. SIPLAD(IB)=0.D0
  98. DSIGZE(IB)=0.D0
  99. ENDIF
  100. SIGMA(IB)=0.D0
  101. DSIGMA(IB)=0.D0
  102. IF(ICINE.EQ.0) GO TO 8816
  103. SPHER(IB)=0.D0
  104. IF(ICENT2.EQ.0) GO TO 8816
  105. AUXIL(IB)=0.D0
  106. 8816 CONTINUE
  107. c
  108. GO TO(101,102,101,104,105,101,102,101,109,110,
  109. . 101,101,113,101),ITYP
  110. c
  111. 101 CONTINUE
  112. IF(IRELAX.NE.0) THEN
  113. DO 135 IB=1,NSTRS
  114. SIPLAD(IB)=VARIN0(2)
  115. 135 DSIGZE(IB)=VARIN0(1+IB+2*NSTRS)
  116. ENDIF
  117. c
  118. DO 136 IB=1,IBM
  119. SIGMA(IB)=SIG0(IB)
  120. DSIGMA(IB)=DSIGT(IB)
  121. IF(ICINE.EQ.0) GO TO 136
  122. IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 136
  123. SPHER(IB)=VARIN0(IB+1)
  124. IF(ICENT2.EQ.0) GO TO 136
  125. AUXIL(IB)=VARIN0(NSTRS+1+IB)
  126. SPHER(IB)=SPHER(IB)+AUXIL(IB)
  127. 136 CONTINUE
  128. GO TO 199
  129. c
  130. 102 CONTINUE
  131. EP1=CARAC(1)
  132. EP2=CARAC(1)*CARAC(1)/6.D0
  133. IF(IFOUR.GT.0) GO TO 1870
  134. IF(IRELAX.NE.0) THEN
  135. JB=0
  136. DO 1836 IB=1,IBOU
  137. IF(IB.EQ.3.OR.IB.EQ.6) GO TO 1836
  138. JB=JB+1
  139. SIPLAD(IB)=VARIN0(2)
  140. 1836 DSIGZE(IB)=VARIN0(1+JB+2*NSTRS)
  141. ENDIF
  142. c
  143. JB=0
  144. IBO2=IBOU/2
  145. JB2=NSTRS/2
  146. DO 1838 IB=1,2
  147. JB=JB+1
  148. SIGMA(IB)=SIG0(JB)/EP1
  149. SIGMA(IB+IBO2)=SIG0(JB+JB2)/EP2
  150. DSIGMA(IB)=DSIGT(JB)/EP1
  151. DSIGMA(IB+IBO2)=DSIGT(JB+JB2)/EP2
  152. IF(ICINE.EQ.0) GO TO 1838
  153. IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 1838
  154. SPHER(IB)=VARIN0(JB+1)/EP1
  155. SPHER(IB+IBO2)=VARIN0(JB+JB2+1)/EP2
  156. IF(ICENT2.EQ.0) GO TO 1838
  157. AUXIL(IB)=VARIN0(NSTRS+1+JB)/EP1
  158. AUXIL(IB+IBO2)=VARIN0(NSTRS+1+JB+JB2)/EP2
  159. SPHER(IB)=SPHER(IB)+AUXIL(IB)
  160. SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2)
  161. 1838 CONTINUE
  162. GO TO 199
  163. c
  164. 1870 CONTINUE
  165. IF(IRELAX.NE.0) THEN
  166. DO 137 IB=1,NSTRS
  167. SIPLAD(IB)=VARIN0(2)
  168. 137 DSIGZE(IB)=VARIN0(1+IB+2*NSTRS)
  169. ENDIF
  170. c
  171. IBO2=IBOU/2
  172. DO 138 IB=1,IBO2
  173. SIGMA(IB)=SIG0(IB)/EP1
  174. SIGMA(IB+IBO2)=SIG0(IB+IBO2)/EP2
  175. DSIGMA(IB)=DSIGT(IB)/EP1
  176. DSIGMA(IB+IBO2)=DSIGT(IB+IBO2)/EP2
  177. IF(ICINE.EQ.0) GO TO 138
  178. IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 138
  179. SPHER(IB)=VARIN0(IB+1)/EP1
  180. SPHER(IB+IBO2)=VARIN0(IB+1+IBO2)/EP2
  181. IF(ICENT2.EQ.0) GO TO 138
  182. AUXIL(IB)=VARIN0(NSTRS+1+IB)/EP1
  183. AUXIL(IB+IBO2)=VARIN0(NSTRS+1+IB+IBO2)/EP2
  184. SPHER(IB)=SPHER(IB)+AUXIL(IB)
  185. SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2)
  186. 138 CONTINUE
  187. GO TO 199
  188. c
  189. 104 CONTINUE
  190. IF(IRELAX.NE.0) THEN
  191. SIPLAD(3)=VARIN0(2)
  192. DSIGZE(3)=VARIN0(2+2*NSTRS)
  193. ENDIF
  194. c
  195. SIGMA(3)=SIG0(1)
  196. DSIGMA(3)=DSIGT(1)
  197. IF(ICINE.EQ.0) GO TO 436
  198. IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 436
  199. SPHER(3)=VARIN0(2)
  200. IF(ICENT2.EQ.0) GO TO 436
  201. AUXIL(3)=VARIN0(NSTRS+2)
  202. SPHER(3)=SPHER(3)+AUXIL(3)
  203. 436 CONTINUE
  204. GO TO 199
  205. c
  206. 105 CONTINUE
  207. GO TO 199
  208. c
  209. 109 CONTINUE
  210. GO TO 199
  211. c
  212. 110 CONTINUE
  213. GO TO 199
  214. c
  215. 113 CONTINUE
  216. IF(IRELAX.NE.0) THEN
  217. JB=0
  218. DO 166 IB=1,IBOU
  219. IF(IB.EQ.3) GO TO 166
  220. JB=JB+1
  221. SIPLAD(IB)=VARIN0(2)
  222. DSIGZE(IB)=VARIN0(1+JB+2*NSTRS)
  223. 166 continue
  224. ENDIF
  225. c
  226. JB=0
  227. DO 168 IB=1,IBOU
  228. IF(IB.EQ.3) GO TO 168
  229. JB=JB+1
  230. SIGMA(IB)=SIG0(JB)
  231. DSIGMA(IB)=DSIGT(JB)
  232. IF(ICINE.EQ.0) GO TO 168
  233. IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 168
  234. SPHER(IB)=VARIN0(JB+1)
  235. IF(ICENT2.EQ.0) GO TO 168
  236. AUXIL(IB)=VARIN0(NSTRS+1+JB)
  237. SPHER(IB)=SPHER(IB)+AUXIL(IB)
  238. 168 CONTINUE
  239. GO TO 199
  240. c
  241. 199 RETURN
  242. c
  243. 9002 CONTINUE
  244. c
  245. GO TO(201,202,201,204,205,201,202,201,209,210,
  246. . 201,201,213,201),ITYP
  247. c
  248. 201 CONTINUE
  249. DO 281 IB=1,IBM
  250. SIGF(IB)=SIGFIN(IB)
  251. DEFP(IB)=DEFPLA(IB)
  252. IF(ICINE.EQ.0) GO TO 281
  253. IF(LFLUAG.EQ.1) GO TO 281
  254. VARINF(1+IB)=SPHER(IB)
  255. IF (ICENT2.NE.0) VARINF(NSTRS+1+IB)=AUXIL(IB)
  256. 281 CONTINUE
  257. GO TO 299
  258. c
  259. 202 CONTINUE
  260. EP1=CARAC(1)
  261. EP2=CARAC(1)*CARAC(1)/6.D0
  262. IF(IFOUR.GT.0) GO TO 2870
  263. JB=0
  264. IBO2=IBOU/2
  265. JB2=NSTRS/2
  266. DO 2282 IB=1,2
  267. JB=JB+1
  268. SIGF(JB)=SIGFIN(IB)*EP1
  269. SIGF(JB+JB2)=SIGFIN(IB+IBO2)*EP2
  270. DEFP(JB)=DEFPLA(IB)
  271. DEFP(JB+JB2)=2*DEFPLA(IB+IBO2)/EP1
  272. IF(ICINE.EQ.0) GO TO 2282
  273. IF(LFLUAG.EQ.1) GO TO 2282
  274. VARINF(1+JB)=SPHER(IB)*EP1
  275. VARINF(1+JB+JB2)=SPHER(IB+IBO2)*EP2
  276. IF(ICENT2.NE.0) THEN
  277. VARINF(NSTRS+1+JB)=AUXIL(IB)*EP1
  278. VARINF(NSTRS+1+JB+JB2)=AUXIL(IB+IBO2)*EP2
  279. ENDIF
  280. 2282 CONTINUE
  281. GO TO 299
  282. c
  283. 2870 CONTINUE
  284. IBO2=IBOU/2
  285. DO 282 IB=1,IBO2
  286. SIGF(IB)=SIGFIN(IB)*EP1
  287. SIGF(IB+IBO2)=SIGFIN(IB+IBO2)*EP2
  288. DEFP(IB)=DEFPLA(IB)
  289. DEFP(IB+IBO2)=2*DEFPLA(IB+IBO2)/EP1
  290. IF(ICINE.EQ.0) GO TO 282
  291. IF(LFLUAG.EQ.1) GO TO 282
  292. VARINF(1+IB)=SPHER(IB)*EP1
  293. VARINF(1+IB+IBO2)=SPHER(IB+IBO2)*EP2
  294. IF(ICENT2.NE.0) THEN
  295. VARINF(NSTRS+1+IB)=AUXIL(IB)*EP1
  296. VARINF(NSTRS+1+IB+IBO2)=AUXIL(IB+IBO2)*EP2
  297. ENDIF
  298. 282 CONTINUE
  299. IF(MFR.NE.9) GO TO 299
  300. IBM1=IBM+1
  301. DO 2821 IB=IBM1,NSTRS
  302. SIGF(IB)=SIG0(IB)+DSIGT(IB)
  303. DEFP(IB)=0.D0
  304. IF(ICINE.EQ.0) GO TO 2821
  305. IF(LFLUAG.EQ.1) GO TO 2821
  306. VARINF(1+IB)=0.D0
  307. IF(ICENT2.NE.0) VARINF(NSTRS+1+IB)=0.D0
  308. 2821 CONTINUE
  309. GO TO 299
  310. c
  311. 204 CONTINUE
  312. SIGF(1)=SIGFIN(3)
  313. DEFP(1)=DEFPLA(3)
  314. IF(ICINE.EQ.0) GO TO 481
  315. IF(LFLUAG.EQ.1) GO TO 481
  316. VARINF(2)=SPHER(3)
  317. IF(ICENT2.NE.0) VARINF(NSTRS+2)=AUXIL(3)
  318. 481 CONTINUE
  319. GO TO 299
  320. c
  321. 205 CONTINUE
  322. GO TO 299
  323. c
  324. 209 CONTINUE
  325. GO TO 299
  326. c
  327. 210 CONTINUE
  328. GO TO 299
  329. c
  330. 213 CONTINUE
  331. JB=0
  332. DO 681 IB=1,IBOU
  333. IF(IB.EQ.3) GO TO 681
  334. JB=JB+1
  335. SIGF(JB)=SIGFIN(IB)
  336. DEFP(JB)=DEFPLA(IB)
  337. IF(ICINE.EQ.0) GO TO 681
  338. IF(LFLUAG.EQ.1) GO TO 681
  339. VARINF(1+JB)=SPHER(IB)
  340. IF(ICENT2.NE.0) VARINF(NSTRS+1+JB)=AUXIL(IB)
  341. 681 CONTINUE
  342. GO TO 299
  343. c
  344. 299 RETURN
  345. END
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  

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