Télécharger comcre.eso

Retour à la liste

Numérotation des lignes :

  1. C COMCRE SOURCE CB215821 18/09/13 21:15:12 9917
  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 (typree) 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 (typree) 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. typree = typdec(1:6).eq.'REAL*8'
  171.  
  172. condec = conmod
  173. ifodec = IFOUR
  174. indec = irang
  175. infdec(1) = 0
  176. infdec(2) = 0
  177. infdec(3) = NIFOUR
  178. infdec(4) = IPMINT
  179. infdec(5) = 0
  180. infdec(6) = lesupp
  181. *
  182. if(jecree.eq.0) then
  183. if(jm.le.jtestj.and.jluc.eq.13)go to 356
  184. if(dec1.ne.0) then
  185. segact dec1
  186. ieldec = dec1.ieldec
  187. * write(6,*) 'dec rep', nomdec, ieldec, deche,condec
  188. ******** segdes dec1
  189. go to 345
  190. endif
  191. endif
  192. 356 continue
  193. if (type(icmn)(1:6).eq.'REAL*8') then
  194. N1PTEL=NBPTEL
  195. N1EL=NEL
  196. N2PTEL=0
  197. N2EL=0
  198. else
  199. N2PTEL=NBPTEL
  200. N2EL=NEL
  201. N1PTEL=0
  202. N1EL=0
  203. endif
  204. segini melval
  205. * write(6,*) 'cree ',nomdec,melval,n1ptel,n1el,condec
  206. ieldec = melval
  207. ** segdes melval
  208. 345 continue
  209. ** segdes deche
  210. 30 continue
  211.  
  212. do 31 jm =1,mfac
  213. dec1=pilfac(jm,irang-1)
  214. if(dec1.eq.0) dec1=pilfac(jm,1)
  215. if (jluc.eq.20) then
  216. if (formod(1).eq.'LIAISON ') goto 340
  217. * kich : composantes facultatives MODAL / STATIQUE
  218. else if (jluc.eq.11) then
  219. if (imatee.eq.9 .or. imatee.eq.10) goto 340
  220. endif
  221. if(dec1.eq.0) go to 31
  222. 340 segini deche
  223. ijlcon=ijlcon+1
  224. if(ijlcon.gt.iilcon) then
  225. iilcon = iilcon+mfac
  226. segadj lilcon
  227. endif
  228. lilcon(ijlcon) = deche
  229. pilfac(jm,irang)=deche
  230. nomdec = lesfac(jm)
  231. imadec = imamod
  232. ICMN=MIN(jm+nobl,NBTYPE)
  233. typdec = type(icmn)
  234. typree = typdec(1:6).eq.'REAL*8'
  235. condec = conmod
  236. ifodec = IFOUR
  237. indec = irang
  238. infdec(1) = 0
  239. infdec(2) = 0
  240. infdec(3) = NIFOUR
  241. infdec(4) = IPMINT
  242. infdec(5) = 0
  243. infdec(6) = lesupp
  244. if(jecree.eq.0.and.dec1.gt.0) then
  245. segact dec1
  246. ieldec=dec1.ieldec
  247. ** segdes dec1
  248. * write(6,*) 'dec fac rep', nomdec, ieldec, deche,condec
  249. go to 346
  250. endif
  251. if (type(icmn)(1:6).eq.'REAL*8') then
  252. N1PTEL=NBPTEL
  253. N1EL =NEL
  254. N2PTEL=0
  255. N2EL =0
  256. else
  257. N2PTEL=NBPTEL
  258. N2EL =NEL
  259. N1PTEL=0
  260. N1EL =0
  261. endif
  262. *
  263. segini melval
  264. * write(6,*) 'cree fac',cmatee,nomdec,melvaln1ptel,n1el,condec
  265. ieldec = melval
  266. *********** segdes melval
  267. 346 continue
  268. ******** segdes deche
  269. 31 continue
  270.  
  271. 50 CONTINUE
  272. ** segdes nomid,pilnec
  273. segsup notype
  274. *
  275. if (iilcon.ne.ijlcon) then
  276. iilcon=ijlcon
  277. segadj lilcon
  278. endif
  279.  
  280. RETURN
  281. END
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  

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