Télécharger comsor.eso

Retour à la liste

Numérotation des lignes :

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

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