Télécharger comsor.eso

Retour à la liste

Numérotation des lignes :

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

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