Télécharger comcre.eso

Retour à la liste

Numérotation des lignes :

  1. C COMCRE SOURCE BP208322 17/03/01 21:16:05 9325
  2. SUBROUTINE COMCRE(iqmod,ipcon,irang,mocomp,lscont,IPMINT,
  3. & lesupp,iwrk53,jluc,iretou)
  4. *-
  5. * cree les deche necessaires associees aux noms de composantes
  6. * et au rang argument (en sortie a priori)
  7. * garde les adresses dans une pile
  8. *-
  9. *----------------------------------------------------------------
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. *
  13. -INC CCOPTIO
  14. -INC SMMODEL
  15. -INC SMCHAML
  16. c*-INC SMINTE
  17. -INC DECHE
  18. *
  19. imodel = iqmod
  20. wrk53 = iwrk53
  21.  
  22. lilcon = ipcon
  23. iilcon=lilcon(/1)
  24. ijlcon=iilcon
  25.  
  26. pilnec = lscont
  27. ** segact pilnec*mod
  28. mobl = pilobl(/1)
  29. mfac = pilfac(/1)
  30.  
  31. *-------------------------------------------------
  32. *** jecree=0 veut dire de ne pas recreer le champ s'il existe en entrée
  33. *** mais le récupérer.
  34. jecree = 1
  35. jtestj = 0
  36. if (jluc.eq.2.or.jluc.eq.15) then
  37. jecree=0
  38. else if (jluc.eq.14) then
  39. jecree=0
  40. else if(jluc.eq.13) then
  41. if (formod(1).eq.'MECANIQUE') then
  42. jecree=0
  43. else if (formod(1).eq.'POREUX') then
  44. if (inplas.ge.0) jecree=0
  45. else if (formod(1).eq.'LIAISON') then
  46. jecree=0
  47. else if (formod(1).eq.'MELANGE') then
  48. if (cmate.eq.'PARALLEL') jecree=0
  49. else if (formod(1).eq.'DIFFUSION') then
  50. jecree=0
  51. endif
  52. * specifique pour endommagement sic_sic
  53. if (inplas.eq. 88) jtestj=15
  54. * specifique pour viscoplastique parfait
  55. if (inplas.eq. 43) jtestj=6
  56. * specifique pour plastique isotrope tuyau
  57. if (inplas.eq. 5) jtestj=3
  58. * specifique pour orthotrope viscoplastique mistral
  59. if (inplas.eq. 94) jtestj=15
  60. endif
  61.  
  62. nomid = mocomp
  63. ** segact nomid*nomod
  64.  
  65. nobl = lesobl(/2)
  66. nfac = lesfac(/2)
  67. call cotype(iqmod,jluc,motype,iwrk53,nobl,nfac)
  68. notype = motype
  69.  
  70. nbtype = 0
  71. if (notype.NE.0) then
  72. nbtype = type(/2)
  73. ENDIF
  74. if (nbtype.ne.0) GOTO 200
  75. *
  76. do jm =1,mobl
  77. dec1=pilobl(jm,2)
  78. if(dec1.eq.0) then
  79. dec1=pilobl(jm,1)
  80. endif
  81. if (FORMOD(1).EQ.'MELANGE'.and.cmate.eq.'PARALLEL'
  82. &.and.pilobl(jm,3).gt.0 ) dec1 = pilobl(jm,3)
  83. if (dec1.gt.0) then
  84. segini,deche=dec1
  85. indec = irang
  86. ijlcon=ijlcon+1
  87. if(ijlcon.gt.iilcon) then
  88. iilcon=iilcon+mobl+mfac
  89. segadj lilcon
  90. endif
  91. lilcon(ijlcon) = deche
  92. if (jecree.eq.1) then
  93. if (typdec(1:8).eq.'REAL*8') then
  94. N1PTEL=NBPTEL
  95. N1EL=NEL
  96. N2PTEL=0
  97. N2EL=0
  98. else
  99. N2PTEL=NBPTEL
  100. N2EL=NEL
  101. N1PTEL=0
  102. N1EL=0
  103. endif
  104. segini melval
  105. ieldec = melval
  106. ** segdes melval
  107. else
  108. * write(6,*) 'deche imite',nomdec,ieldec,n1ptel,n1el,condec,jecree
  109. endif
  110. ** segdes deche
  111. pilobl(jm,irang)= deche
  112. endif
  113. enddo
  114.  
  115. do jm =1,mfac
  116. dec1=pilfac(jm,2)
  117. if (dec1.gt.0) then
  118. segini,deche=dec1
  119. indec = irang
  120. ijlcon=ijlcon+1
  121. if(ijlcon.gt.iilcon) then
  122. iilcon=iilcon+mfac
  123. segadj lilcon
  124. endif
  125. lilcon(ijlcon) = deche
  126. if(jecree.eq.1) then
  127. if (typdec(1:8).eq.'REAL*8') then
  128. N1PTEL=NBPTEL
  129. N1EL=NEL
  130. N2PTEL=0
  131. N2EL=0
  132. else
  133. N2PTEL=NBPTEL
  134. N2EL=NEL
  135. N1PTEL=0
  136. N1EL=0
  137. endif
  138. segini melval
  139. ieldec = melval
  140. ** segdes melval
  141. endif
  142. ** segdes deche
  143. pilfac(jm,irang)= deche
  144. endif
  145. enddo
  146.  
  147. GOTO 50
  148.  
  149. 200 CONTINUE
  150. deche = lilcon(1)
  151. ** segact deche*nomod
  152. * n3 a revoir
  153. n3 = infdec(/1)
  154. ** segdes deche
  155. do 30 jm = 1, mobl
  156. dec1=pilobl(jm,irang-1)
  157. if(dec1.eq.0) dec1=pilobl(jm,1)
  158. segini deche
  159. ijlcon=ijlcon+1
  160. if( ijlcon.gt.iilcon) then
  161. iilcon=iilcon + mobl + mfac
  162. segadj lilcon
  163. endif
  164. lilcon(ijlcon) = deche
  165. pilobl(jm,irang)=deche
  166. nomdec = lesobl(jm)
  167. imadec = imamod
  168. ICMN=MIN(jm,NBTYPE)
  169. typdec = type(icmn)
  170.  
  171. condec = conmod
  172. ifodec = IFOUR
  173. indec = irang
  174. infdec(1) = 0
  175. infdec(2) = 0
  176. infdec(3) = NIFOUR
  177. infdec(4) = IPMINT
  178. infdec(5) = 0
  179. infdec(6) = lesupp
  180. *
  181. if(jecree.eq.0) then
  182. if(jm.le.jtestj.and.jluc.eq.13)go to 356
  183. if(dec1.ne.0) then
  184. segact dec1
  185. ieldec = dec1.ieldec
  186. * write(6,*) 'dec rep', nomdec, ieldec, deche,condec
  187. ******** segdes dec1
  188. go to 345
  189. endif
  190. endif
  191. 356 continue
  192. if (type(icmn)(1:8).eq.'REAL*8') then
  193. N1PTEL=NBPTEL
  194. N1EL=NEL
  195. N2PTEL=0
  196. N2EL=0
  197. else
  198. N2PTEL=NBPTEL
  199. N2EL=NEL
  200. N1PTEL=0
  201. N1EL=0
  202. endif
  203. segini melval
  204. * write(6,*) 'cree ',nomdec,melval,n1ptel,n1el,condec
  205. ieldec = melval
  206. ** segdes melval
  207. 345 continue
  208. ** segdes deche
  209. 30 continue
  210.  
  211. do 31 jm =1,mfac
  212. dec1=pilfac(jm,irang-1)
  213. if(dec1.eq.0) dec1=pilfac(jm,1)
  214. if (jluc.eq.20) then
  215. if (formod(1).eq.'LIAISON') goto 340
  216. * kich : composantes facultatives MODAL / STATIQUE
  217. else if (jluc.eq.11) then
  218. if (imatee.eq.9 .or. imatee.eq.10) goto 340
  219. endif
  220. if(dec1.eq.0) go to 31
  221. 340 segini deche
  222. ijlcon=ijlcon+1
  223. if(ijlcon.gt.iilcon) then
  224. iilcon = iilcon+mfac
  225. segadj lilcon
  226. endif
  227. lilcon(ijlcon) = deche
  228. pilfac(jm,irang)=deche
  229. nomdec = lesfac(jm)
  230. imadec = imamod
  231. ICMN=MIN(jm+nobl,NBTYPE)
  232. typdec = type(icmn)
  233. condec = conmod
  234. ifodec = IFOUR
  235. indec = irang
  236. infdec(1) = 0
  237. infdec(2) = 0
  238. infdec(3) = NIFOUR
  239. infdec(4) = IPMINT
  240. infdec(5) = 0
  241. infdec(6) = lesupp
  242. if(jecree.eq.0.and.dec1.gt.0) then
  243. segact dec1
  244. ieldec=dec1.ieldec
  245. ** segdes dec1
  246. * write(6,*) 'dec fac rep', nomdec, ieldec, deche,condec
  247. go to 346
  248. endif
  249. if (type(icmn)(1:8).eq.'REAL*8') then
  250. N1PTEL=NBPTEL
  251. N1EL=NEL
  252. N2PTEL=0
  253. N2EL=0
  254. else
  255. N2PTEL=NBPTEL
  256. N2EL=NEL
  257. N1PTEL=0
  258. N1EL=0
  259. endif
  260. *
  261. segini melval
  262. * write(6,*) 'cree fac',cmatee,nomdec,melvaln1ptel,n1el,condec
  263. ieldec = melval
  264. *********** segdes melval
  265. 346 continue
  266. ******** segdes deche
  267. 31 continue
  268.  
  269. 50 CONTINUE
  270. ** segdes nomid,pilnec
  271. segsup notype
  272. *
  273. if (iilcon.ne.ijlcon) then
  274. iilcon=ijlcon
  275. segadj lilcon
  276. endif
  277.  
  278. RETURN
  279. END
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  

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