Télécharger comsor.eso

Retour à la liste

Numérotation des lignes :

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

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