Télécharger comcre.eso

Retour à la liste

Numérotation des lignes :

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

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