Télécharger comsor.eso

Retour à la liste

Numérotation des lignes :

  1. C COMSOR SOURCE PV 17/07/10 21:15:01 9489
  2. SUBROUTINE COMSOR(iqmod,ililuc,iwrk52,iwrk53,iwrk54,
  3. & ib,igau,iecou,xecou)
  4. *
  5. **********************************************************************
  6. * range les resultats du tableau wrk52 dans les melval
  7. **********************************************************************
  8. *
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11. *
  12. -INC CCOPTIO
  13. -INC SMCHAML
  14. -INC SMMODEL
  15. * segment deroulant le mcheml
  16. -INC DECHE
  17.  
  18. SEGMENT IECOU
  19. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  20. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  21. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15, IND,
  22. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  23. 2 NSOM, NINV, NINCMA,NCOMP,icow21,icow22,icow23,icow24,
  24. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  25. 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
  26. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  27. 4 icow32,icow33,icow34,icow35,icow36,icow37,icow38,
  28. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  29. 5 icow39,icow40,icow41,icow42,icow43,icow44,NYOG1,
  30. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME,NYOG1,
  31. 6 NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2,
  32. C . NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2,
  33. 7 NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  34. C . NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  35. ENDSEGMENT
  36. SEGMENT XECOU
  37. REAL*8 DTOPTI, TSOM,TCAR,xcow4,xcow5,xcow6, xcow7
  38. ENDSEGMENT
  39. *
  40. imodel = iqmod
  41. liluc = ililuc
  42. nbluc1 = liluc(/1)
  43. wrk52 = iwrk52
  44. wrk53 = iwrk53
  45. wrk54 = iwrk54
  46. *
  47. *-------------------------------------------
  48. * rearrangement pour milieu poreux
  49. *-------------------------------------------
  50. IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
  51. ICAS=2
  52. CALL COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,IECOU,ICAS,IRETOU)
  53. ENDIF
  54. *
  55. do 1000 ino = 1,nbluc1
  56. if (formod(1).eq.'DIFFUSION') goto 47
  57. *tctc on ne garde que contraintes deformation defiela varinter
  58. if(ino.ne.11.and.ino.ne.20.and.ino.ne.24.and.ino.ne.12.
  59. $ and.ino.ne.13.and.ino.ne.14) go to 1000
  60. 47 continue
  61. pilnec = liluc(ino,2)
  62. if (pilnec.le.0) goto 1000
  63. mran = pilobl(/2)
  64. * mran doit correspondre a indeso : indice du deche resultat
  65. if (mran.le.0) goto 1000
  66. mobl = pilobl(/1)
  67. mfac = pilfac(/1)
  68. if (mobl.le.0) goto 101
  69.  
  70. do 100 ic = 1,mobl
  71. if (pilobl(ic,mran).gt.0) then
  72. deche = pilobl(ic,mran)
  73. * on ne modifie que les champs lies au constituant
  74. if (condec.ne.conmod) goto 100
  75. melval = ieldec
  76. else
  77. goto 100
  78. endif
  79. *
  80. * AIGUILLAGE SUIVANT MOT CLE
  81. *
  82. if (ino.gt.nmot) goto 98
  83. GOTO ( 1, 2, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 17,18,
  84. 1 99,20,21,99,23,24,99) ino
  85. *
  86. 99 CONTINUE
  87. c pas de composantes pour ce champ
  88. RETURN
  89. *
  90. 1 passe1 = scalf(ic)
  91. GOTO 120
  92. *
  93. 2 continue
  94. passe1 = tempf
  95. GOTO 120
  96. *
  97. 6 passe1 = deplf(ic)
  98. GOTO 120
  99. *
  100. 7 passe1 = forcf(ic)
  101. GOTO 120
  102. *
  103. 10 passe1 = gradf(ic)
  104. GOTO 120
  105. *
  106. 11 passe1 = SIGF(ic)
  107. GOTO 120
  108. *
  109. 12 passe1 = epstf(ic)
  110. GOTO 120
  111. *
  112. 13 continue
  113. passe1 = xmatf(ic)
  114. GOTO 120
  115. *
  116. 14 passe1 = xcarbf(ic)
  117. GOTO 120
  118. *
  119. 15 passe1 = turef(ic)
  120. GOTO 120
  121. *
  122. 16 passe1 = prinf(ic)
  123. GOTO 120
  124. *
  125. 17 passe1 = mahof(ic)
  126. GOTO 120
  127. *
  128. 18 passe1 = hotaf(ic)
  129. GOTO 120
  130. *
  131. 20 passe1 = VARF(ic)
  132. GOTO 120
  133. *
  134. 21 passe1 = graff(ic)
  135. GOTO 120
  136. *
  137. 23 passe1 = rhasf(ic)
  138. GOTO 120
  139. *
  140. 24 continue
  141. IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  142. & .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66.OR.INPLAS.EQ.118
  143. & .OR.INPLAS.EQ.141.OR.INPLAS.EQ.176)THEN
  144. passe1 =EPINF(IC)
  145. ELSE
  146. passe1= epin0(ic) + defp(IC)
  147. ENDIF
  148. GOTO 120
  149. *
  150. 98 passe1 = exova1(ic)
  151. GOTO 120
  152. *
  153. 120 CONTINUE
  154. if (typdec.eq.'REAL*8') then
  155. IBMN=MIN(IB,VELCHE(/2))
  156. IGMN=MIN(IGAU,VELCHE(/1))
  157. VELCHE(IGMN,IBMN)=passe1
  158. else
  159. IBMN=MIN(IB,IELCHE(/2))
  160. IGMN=MIN(IGAU,IELCHE(/1))
  161. IELCHE(IGMN,IBMN)=int(passe1)
  162. *kich un cas particulier --- plus dificile traiter cas géneral
  163. if (typdec(1:8).eq.'POINTEUR'.and.IELCHE(/2).eq.1
  164. &.and.IELCHE(/2).eq.1.and.int(passe1).eq.0) then
  165. segsup melval
  166. indec = -1
  167. pilobl(ic,mran) = 0
  168. endif
  169. endif
  170. *
  171. 100 continue
  172.  
  173. 101 continue
  174. *
  175. * if (mfac.le.0) goto 301
  176. * mran doit correspondre a indeso, indice du deche resultat
  177. do 200 ic = 1,mfac
  178. if (pilfac(ic,mran).gt.0) then
  179. deche = pilfac(ic,mran)
  180. if (condec.ne.conmod) goto 200
  181. melval = ieldec
  182. else
  183. goto 200
  184. endif
  185. *
  186. * AIGUILLAGE SUIVANT MOT CLE
  187. *
  188. GOTO ( 201,202,201,201,201,206, 207,299,299,210,211,
  189. & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  190. if (ino.gt.nmot) goto 298
  191. *
  192. 299 CONTINUE
  193. c pas de composantes pour ce champ
  194. RETURN
  195. *
  196. 201 passe1 = scalf(mobl+ic)
  197. GOTO 320
  198. *
  199. 202 continue
  200. GOTO 320
  201. *
  202. 206 passe1 = deplf(mobl+ic)
  203. GOTO 320
  204. *
  205. 207 passe1 = forcf(mobl+ic)
  206. GOTO 320
  207. *
  208. 210 passe1 = gradf(mobl+ic)
  209. GOTO 320
  210. *
  211. 211 passe1 = SIGF(mobl+ic)
  212. GOTO 320
  213. *
  214. 212 passe1 = epstf(mobl+ic)
  215. GOTO 320
  216. *
  217. 213 passe1 = xmatf(mobl+ic)
  218. GOTO 320
  219. *
  220. 214 passe1 = xcarbf(mobl+ic)
  221. c stockage du pas de temps optimal
  222.  
  223. IF ( INPLAS .EQ. 17 .OR.
  224. 2 ( INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  225. 4 INPLAS .EQ. 61 .OR. INPLAS .EQ. 53 .OR.
  226. 1 INPLAS .EQ. 65 .OR. INPLAS .EQ. 29 .OR.
  227. 1 INPLAS .EQ. 142 .OR.
  228. 2 INPLAS .EQ. 44 .OR. INPLAS .EQ. 45 .OR.
  229. 9 INPLAS .EQ. 76 .OR. INPLAS .EQ. 77 .OR.
  230. 9 INPLAS .EQ. 70 ) THEN
  231.  
  232. C Remarque :
  233. C Le vecteur comcar est rempli par COMVAL : on note le nom de la
  234. C composante lors du premier passage (pour le premier point de Gauss
  235. C du premier element) en recopiant le nom que l'on trouve dans lesobl
  236. C (composante obligatoire) ou lesfac (composante facultative).
  237. C Les vecteurs lesobl et lesfac ont ete remplis par COMOU2 qui pour les
  238. C caracteristiques geometriques a appele IDCARB : en aucun cas on ne
  239. C trouve 'DTOPTI' parmi la liste des composantes geometriques reconnues.
  240. C Qui plus est elle constituerait une exception car 6 caracteres au lieu
  241. C des 4 habituels.
  242. C
  243. C Conclusion : LE TEST CI-DESSOUS if (comcar(mobl+ic).eq.'DTOPTI')
  244. C N'EST JAMAIS SATISFAIT, il n'y a pas stockage du pas de temps optimal.
  245. C
  246. C De plus, on n'a pas trouve de composante 'DTOPTI' ou 'DTOP' dans
  247. C aucune des routines IDxxxx, donc on peut dire que 'DTOPTI' n'est
  248. C une composante d'aucun champ de type connu.
  249. C En particulier, 'DTOPTI' n'est pas une composante materielle ou une
  250. C variable interne reconnue d'un quelconque modele.
  251. C
  252. if (comcar(mobl+ic).eq.'DTOPTI') then
  253. TMOY = TSOM/NCOMP
  254. NMOY = NSOM/NCOMP
  255. IF (IIMPI.GE.1) THEN
  256. WRITE(IOIMP,*)' NBRE DE SS PAS : MOYENNE ',NMOY,
  257. 1 ' MAX ',NINCMA
  258. IF (NINV.NE.0) THEN
  259. WRITE(IOIMP,*)' NBRE D"INVERSION ',NINV,'/',NCOMP
  260. END IF
  261. ENDIF
  262. TECAR = SQRT(ABS(TCAR/NCOMP - TMOY*TMOY))
  263. DTOPTI = MAX(TMOY-TECAR/2.D0,DTOPTI)
  264. passe1=dtopti
  265.  
  266. endif
  267. ENDIF
  268. GOTO 320
  269. *
  270. 215 passe1 = turef(mobl+ic)
  271. GOTO 320
  272. *
  273. 216 passe1 = prinf(mobl+ic)
  274. GOTO 320
  275. *
  276. 217 passe1 = mahof(mobl+ic)
  277. GOTO 320
  278. *
  279. 218 passe1 = hotaf(mobl+ic)
  280. GOTO 320
  281. *
  282. 220 passe1 = VARF(mobl+ic)
  283. GOTO 320
  284. *
  285. 221 passe1 = graff(mobl+ic)
  286. GOTO 320
  287. *
  288. 223 passe1 = rhasf(mobl+ic)
  289. GOTO 320
  290. *
  291. 224 continue
  292. IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  293. & .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66)THEN
  294. passe1 =EPINF(mobl+ic)
  295. ELSE
  296. passe1=epin0(mobl+ic) + defp(mobl+ic)
  297. ENDIF
  298. GOTO 320
  299. *
  300. 298 passe1 =exova1(mobl + ic)
  301. GOTO 320
  302. *
  303. 320 CONTINUE
  304.  
  305. if (typdec.eq.'REAL*8') then
  306. IBMN=MIN(IB,VELCHE(/2))
  307. IGMN=MIN(IGAU,VELCHE(/1))
  308. VELCHE(IGMN,IBMN) = passe1
  309. else
  310. IBMN=MIN(IB,IELCHE(/2))
  311. IGMN=MIN(IGAU,IELCHE(/1))
  312. IELCHE(IGMN,IBMN)= int(passe1)
  313. *kich un cas particulier --- plus dificile traiter cas géneral
  314. if (typdec(1:8).eq.'POINTEUR'.and.IELCHE(/2).eq.1
  315. &.and.IELCHE(/2).eq.1.and.int(passe1).eq.0) then
  316. segsup melval
  317. indec = -1
  318. pilfac(ic,mran) = 0
  319. endif
  320. endif
  321.  
  322. 200 continue
  323.  
  324. 301 continue
  325. *
  326. 1000 continue
  327. *
  328. RETURN
  329. END
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  

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