Télécharger comsor.eso

Retour à la liste

Numérotation des lignes :

  1. C COMSOR SOURCE BP208322 17/03/01 21:16:28 9325
  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. logical nomod
  40. *
  41. imodel = iqmod
  42. liluc = ililuc
  43. nbluc1 = liluc(/1)
  44. wrk52 = iwrk52
  45. c segact wrk52*mod
  46. wrk53 = iwrk53
  47. wrk54 = iwrk54
  48. *
  49. *-------------------------------------------
  50. * rearrangement pour milieu poreux
  51. *-------------------------------------------
  52. IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
  53. ICAS=2
  54. CALL COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,IECOU,ICAS,IRETOU)
  55. ENDIF
  56. *
  57. do 1000 ino = 1,nbluc1
  58. if (formod(1).eq.'DIFFUSION') goto 47
  59. *tctc on ne garde que contraintes deformation defiela varinter
  60. if(ino.ne.11.and.ino.ne.20.and.ino.ne.24.and.ino.ne.12.
  61. $ and.ino.ne.13.and.ino.ne.14) go to 1000
  62. 47 continue
  63. pilnec = liluc(ino,2)
  64. c segact pilnec*nomod
  65. if (pilnec.le.0) goto 1000
  66. mran = pilobl(/2)
  67. * mran doit correspondre a indeso : indice du deche resultat
  68. if (mran.le.0) goto 1000
  69. mobl = pilobl(/1)
  70. mfac = pilfac(/1)
  71. if (mobl.le.0) goto 101
  72.  
  73. do 100 ic = 1,mobl
  74. if (pilobl(ic,mran).gt.0) then
  75. deche = pilobl(ic,mran)
  76. c segact deche*nomod
  77. * on ne modifie que les champs lies au constituant
  78. if (condec.ne.conmod) goto 100
  79. melval = ieldec
  80. nomod=.true.
  81. *** segact melval*mod
  82. else
  83. goto 100
  84. endif
  85. *
  86. * AIGUILLAGE SUIVANT MOT CLE
  87. *
  88. if (ino.gt.nmot) goto 98
  89. GOTO ( 1, 2, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 17,18,
  90. 1 99,20,21,99,23,24,99) ino
  91. *
  92. 99 CONTINUE
  93. c pas de composantes pour ce champ
  94. RETURN
  95. *
  96. 1 passe1 = scalf(ic)
  97. GOTO 120
  98. *
  99. 2 continue
  100. passe1 = tempf
  101. GOTO 120
  102. *
  103. 6 passe1 = deplf(ic)
  104. GOTO 120
  105. *
  106. 7 passe1 = forcf(ic)
  107. GOTO 120
  108. *
  109. 10 passe1 = gradf(ic)
  110. GOTO 120
  111. *
  112. 11 passe1 = SIGF(ic)
  113. GOTO 120
  114. *
  115. 12 passe1 = epstf(ic)
  116. GOTO 120
  117. *
  118. 13 continue
  119. passe1 = xmatf(ic)
  120. GOTO 120
  121. *
  122. 14 passe1 = xcarbf(ic)
  123. GOTO 120
  124. *
  125. 15 passe1 = turef(ic)
  126. GOTO 120
  127. *
  128. 16 passe1 = prinf(ic)
  129. GOTO 120
  130. *
  131. 17 passe1 = mahof(ic)
  132. GOTO 120
  133. *
  134. 18 passe1 = hotaf(ic)
  135. GOTO 120
  136. *
  137. 20 passe1 = VARF(ic)
  138. GOTO 120
  139. *
  140. 21 passe1 = graff(ic)
  141. GOTO 120
  142. *
  143. 23 passe1 = rhasf(ic)
  144. GOTO 120
  145. *
  146. 24 continue
  147. IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  148. & .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66.OR.INPLAS.EQ.118
  149. & .OR.INPLAS.EQ.141.OR.INPLAS.EQ.176)THEN
  150. passe1 =EPINF(IC)
  151. ELSE
  152. passe1= epin0(ic) + defp(IC)
  153. ENDIF
  154. GOTO 120
  155. *
  156. 98 passe1 = exova1(ic)
  157. GOTO 120
  158. *
  159. 120 CONTINUE
  160. if (nomod) segact melval*mod
  161. nomod=.false.
  162. if (typdec.eq.'REAL*8') then
  163. IBMN=MIN(IB,VELCHE(/2))
  164. IGMN=MIN(IGAU,VELCHE(/1))
  165. VELCHE(IGMN,IBMN)=passe1
  166. else
  167. IBMN=MIN(IB,IELCHE(/2))
  168. IGMN=MIN(IGAU,IELCHE(/1))
  169. IELCHE(IGMN,IBMN)=int(passe1)
  170. *kich un cas particulier --- plus dificile traiter cas géneral
  171. if (typdec(1:8).eq.'POINTEUR'.and.IELCHE(/2).eq.1
  172. &.and.IELCHE(/2).eq.1.and.int(passe1).eq.0) then
  173. segsup melval
  174. indec = -1
  175. pilobl(ic,mran) = 0
  176. endif
  177. endif
  178. *
  179. 100 continue
  180.  
  181. 101 continue
  182. *
  183. * if (mfac.le.0) goto 301
  184. * mran doit correspondre a indeso, indice du deche resultat
  185. do 200 ic = 1,mfac
  186. if (pilfac(ic,mran).gt.0) then
  187. deche = pilfac(ic,mran)
  188. c segact deche*nomod
  189. if (condec.ne.conmod) goto 200
  190. melval = ieldec
  191. nomod=.true.
  192. *** segact melval*mod
  193. else
  194. goto 200
  195. endif
  196. *
  197. * AIGUILLAGE SUIVANT MOT CLE
  198. *
  199. GOTO ( 201,202,201,201,201,206, 207,299,299,210,211,
  200. & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  201. if (ino.gt.nmot) goto 298
  202. *
  203. 299 CONTINUE
  204. c pas de composantes pour ce champ
  205. RETURN
  206. *
  207. 201 passe1 = scalf(mobl+ic)
  208. GOTO 320
  209. *
  210. 202 continue
  211. GOTO 320
  212. *
  213. 206 passe1 = deplf(mobl+ic)
  214. GOTO 320
  215. *
  216. 207 passe1 = forcf(mobl+ic)
  217. GOTO 320
  218. *
  219. 210 passe1 = gradf(mobl+ic)
  220. GOTO 320
  221. *
  222. 211 passe1 = SIGF(mobl+ic)
  223. GOTO 320
  224. *
  225. 212 passe1 = epstf(mobl+ic)
  226. GOTO 320
  227. *
  228. 213 passe1 = xmatf(mobl+ic)
  229. GOTO 320
  230. *
  231. 214 passe1 = xcarbf(mobl+ic)
  232. c stockage du pas de temps optimal
  233.  
  234. IF ( INPLAS .EQ. 17 .OR.
  235. 2 ( INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  236. 4 INPLAS .EQ. 61 .OR. INPLAS .EQ. 53 .OR.
  237. 1 INPLAS .EQ. 65 .OR. INPLAS .EQ. 29 .OR.
  238. 1 INPLAS .EQ. 142 .OR.
  239. 2 INPLAS .EQ. 44 .OR. INPLAS .EQ. 45 .OR.
  240. 9 INPLAS .EQ. 76 .OR. INPLAS .EQ. 77 .OR.
  241. 9 INPLAS .EQ. 70 ) THEN
  242.  
  243. C Remarque :
  244. C Le vecteur comcar est rempli par COMVAL : on note le nom de la
  245. C composante lors du premier passage (pour le premier point de Gauss
  246. C du premier element) en recopiant le nom que l'on trouve dans lesobl
  247. C (composante obligatoire) ou lesfac (composante facultative).
  248. C Les vecteurs lesobl et lesfac ont ete remplis par COMOU2 qui pour les
  249. C caracteristiques geometriques a appele IDCARB : en aucun cas on ne
  250. C trouve 'DTOPTI' parmi la liste des composantes geometriques reconnues.
  251. C Qui plus est elle constituerait une exception car 6 caracteres au lieu
  252. C des 4 habituels.
  253. C
  254. C Conclusion : LE TEST CI-DESSOUS if (comcar(mobl+ic).eq.'DTOPTI')
  255. C N'EST JAMAIS SATISFAIT, il n'y a pas stockage du pas de temps optimal.
  256. C
  257. C De plus, on n'a pas trouve de composante 'DTOPTI' ou 'DTOP' dans
  258. C aucune des routines IDxxxx, donc on peut dire que 'DTOPTI' n'est
  259. C une composante d'aucun champ de type connu.
  260. C En particulier, 'DTOPTI' n'est pas une composante materielle ou une
  261. C variable interne reconnue d'un quelconque modele.
  262. C
  263. if (comcar(mobl+ic).eq.'DTOPTI') then
  264. TMOY = TSOM/NCOMP
  265. NMOY = NSOM/NCOMP
  266. IF (IIMPI.GE.1) THEN
  267. WRITE(IOIMP,*)' NBRE DE SS PAS : MOYENNE ',NMOY,
  268. 1 ' MAX ',NINCMA
  269. IF (NINV.NE.0) THEN
  270. WRITE(IOIMP,*)' NBRE D"INVERSION ',NINV,'/',NCOMP
  271. END IF
  272. ENDIF
  273. TECAR = SQRT(ABS(TCAR/NCOMP - TMOY*TMOY))
  274. DTOPTI = MAX(TMOY-TECAR/2.D0,DTOPTI)
  275. passe1=dtopti
  276.  
  277. endif
  278. ENDIF
  279. GOTO 320
  280. *
  281. 215 passe1 = turef(mobl+ic)
  282. GOTO 320
  283. *
  284. 216 passe1 = prinf(mobl+ic)
  285. GOTO 320
  286. *
  287. 217 passe1 = mahof(mobl+ic)
  288. GOTO 320
  289. *
  290. 218 passe1 = hotaf(mobl+ic)
  291. GOTO 320
  292. *
  293. 220 passe1 = VARF(mobl+ic)
  294. GOTO 320
  295. *
  296. 221 passe1 = graff(mobl+ic)
  297. GOTO 320
  298. *
  299. 223 passe1 = rhasf(mobl+ic)
  300. GOTO 320
  301. *
  302. 224 continue
  303. IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30
  304. & .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66)THEN
  305. passe1 =EPINF(mobl+ic)
  306. ELSE
  307. passe1=epin0(mobl+ic) + defp(mobl+ic)
  308. ENDIF
  309. GOTO 320
  310. *
  311. 298 passe1 =exova1(mobl + ic)
  312. GOTO 320
  313. *
  314. 320 CONTINUE
  315.  
  316. if (nomod) segact melval*mod
  317. nomod=.false.
  318. if (typdec.eq.'REAL*8') then
  319. IBMN=MIN(IB,VELCHE(/2))
  320. IGMN=MIN(IGAU,VELCHE(/1))
  321. VELCHE(IGMN,IBMN) = passe1
  322. else
  323. IBMN=MIN(IB,IELCHE(/2))
  324. IGMN=MIN(IGAU,IELCHE(/1))
  325. IELCHE(IGMN,IBMN)= int(passe1)
  326. *kich un cas particulier --- plus dificile traiter cas géneral
  327. if (typdec(1:8).eq.'POINTEUR'.and.IELCHE(/2).eq.1
  328. &.and.IELCHE(/2).eq.1.and.int(passe1).eq.0) then
  329. segsup melval
  330. indec = -1
  331. pilfac(ic,mran) = 0
  332. endif
  333. endif
  334.  
  335. 200 continue
  336.  
  337. 301 continue
  338. *
  339. 1000 continue
  340. *
  341. RETURN
  342. END
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  

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