Télécharger comcre.eso

Retour à la liste

Numérotation des lignes :

comcre
  1. C COMCRE SOURCE JK148537 23/08/21 21:15:07 11723
  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.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMMODEL
  17. -INC SMCHAML
  18. -INC DECHE
  19. *
  20. imodel = iqmod
  21. wrk53 = iwrk53
  22.  
  23. lilcon = ipcon
  24. iilcon=lilcon(/1)
  25. ijlcon=iilcon
  26.  
  27. pilnec = lscont
  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. else if(jluc.eq.23) then
  61. if (formod(1).eq.'MELANGE ') then
  62. if (cmate.eq.'PARALLEL') jecree=0
  63. endif
  64. else if(jluc.eq.26) then
  65. jecree = 0
  66. endif
  67.  
  68. nomid = mocomp
  69. if (nomid.le.0) return
  70.  
  71. nobl = lesobl(/2)
  72. nfac = lesfac(/2)
  73. call cotype(iqmod,jluc,motype,iwrk53,nobl,nfac)
  74. notype = motype
  75.  
  76. nbtype = 0
  77. if (notype.NE.0) then
  78. nbtype = type(/2)
  79. ENDIF
  80.  
  81. if (nbtype.ne.0) GOTO 200
  82. *
  83. do jm =1,mobl
  84. dec1=pilobl(jm,2)
  85. if(dec1.eq.0) then
  86. dec1=pilobl(jm,1)
  87. endif
  88. if(FORMOD(1).EQ.'MELANGE '.and.cmate.eq.'PARALLEL'
  89. & .and.pilobl(jm,3).gt.0 ) dec1 = pilobl(jm,3)
  90. if (dec1.gt.0) then
  91. segini,deche=dec1
  92. indec = irang
  93. ijlcon=ijlcon+1
  94. if(ijlcon.gt.iilcon) then
  95. iilcon=iilcon+mobl+mfac
  96. segadj lilcon
  97. endif
  98. lilcon(ijlcon) = deche
  99. if (jecree.eq.1) then
  100. if (typree) then
  101. N1PTEL=NBPTEL
  102. N1EL=NEL
  103. N2PTEL=0
  104. N2EL=0
  105. else
  106. N2PTEL=NBPTEL
  107. N2EL=NEL
  108. N1PTEL=0
  109. N1EL=0
  110. endif
  111. segini melval
  112. ieldec = melval
  113. else
  114. c if (cmate.eq.'PARALLEL'.and.jluc.eq.23)
  115. c &write(6,*) 'deche imite',nomdec,ieldec,n1ptel,n1el,condec,jecree
  116. endif
  117. pilobl(jm,irang)= deche
  118. endif
  119. enddo
  120.  
  121. do jm =1,mfac
  122. dec1=pilfac(jm,2)
  123. if (dec1.gt.0) then
  124. segini,deche=dec1
  125. indec = irang
  126. ijlcon=ijlcon+1
  127. if(ijlcon.gt.iilcon) then
  128. iilcon=iilcon+mfac
  129. segadj lilcon
  130. endif
  131. lilcon(ijlcon) = deche
  132. if(jecree.eq.1) then
  133. if (typree) then
  134. N1PTEL=NBPTEL
  135. N1EL=NEL
  136. N2PTEL=0
  137. N2EL=0
  138. else
  139. N2PTEL=NBPTEL
  140. N2EL=NEL
  141. N1PTEL=0
  142. N1EL=0
  143. endif
  144. segini melval
  145. ieldec = melval
  146. ** segdes melval
  147. endif
  148. ** segdes deche
  149. pilfac(jm,irang)= deche
  150. endif
  151. enddo
  152.  
  153. GOTO 50
  154.  
  155. 200 CONTINUE
  156. deche = lilcon(1)
  157. * n3 a revoir
  158. n3 = infdec(/1)
  159. ** segdes deche
  160. do 30 jm = 1, mobl
  161. dec1=pilobl(jm,irang-1)
  162. if(FORMOD(1).EQ.'MELANGE '.and.cmate.eq.'PARALLEL'
  163. & .and.pilobl(jm,3).gt.0 ) dec1 = pilobl(jm,3)
  164. if(dec1.eq.0) dec1=pilobl(jm,1)
  165. segini deche
  166. ijlcon=ijlcon+1
  167. if( ijlcon.gt.iilcon) then
  168. iilcon=iilcon + mobl + mfac
  169. segadj lilcon
  170. endif
  171. lilcon(ijlcon) = deche
  172. pilobl(jm,irang)=deche
  173. nomdec = lesobl(jm)
  174. imadec = imamod
  175. ICMN=MIN(jm,NBTYPE)
  176. typdec = type(icmn)
  177. typree = typdec(1:6).eq.'REAL*8'
  178.  
  179. condec = conmod
  180. ifodec = IFOUR
  181. indec = irang
  182. infdec(1) = 0
  183. infdec(2) = 0
  184. infdec(3) = NIFOUR
  185. infdec(4) = IPMINT
  186. infdec(5) = 0
  187. infdec(6) = lesupp
  188. *
  189. if(jecree.eq.0) then
  190. if(jm.le.jtestj.and.jluc.eq.13)go to 356
  191. if(dec1.ne.0) then
  192. ieldec = dec1.ieldec
  193. c if (cmate.eq.'PARALLEL'.and.jluc.eq.23)
  194. c &write(6,*) 'dec rep', nomdec, ieldec, deche,dec1.condec,dec1.indec
  195. go to 345
  196. endif
  197. endif
  198. 356 continue
  199. if (type(icmn)(1:6).eq.'REAL*8') then
  200. N1PTEL=NBPTEL
  201. N1EL=NEL
  202. N2PTEL=0
  203. N2EL=0
  204. else
  205. N2PTEL=NBPTEL
  206. N2EL=NEL
  207. N1PTEL=0
  208. N1EL=0
  209. endif
  210. segini melval
  211. * write(6,*) 'cree ',nomdec,melval,n1ptel,n1el,condec
  212. ieldec = melval
  213. ** segdes melval
  214. 345 continue
  215. ** segdes deche
  216. 30 continue
  217.  
  218. do 31 jm =1,mfac
  219. dec1=pilfac(jm,irang-1)
  220. if(dec1.eq.0) dec1=pilfac(jm,1)
  221. if (jluc.eq.20) then
  222. if (formod(1).eq.'LIAISON ') goto 340
  223. * kich : composantes facultatives MODAL / STATIQUE
  224. else if (jluc.eq.11) then
  225. if (imatee.eq.9 .or. imatee.eq.10) goto 340
  226. endif
  227. if(dec1.eq.0) go to 31
  228. 340 segini deche
  229. ijlcon=ijlcon+1
  230. if(ijlcon.gt.iilcon) then
  231. iilcon = iilcon+mfac
  232. segadj lilcon
  233. endif
  234. lilcon(ijlcon) = deche
  235. pilfac(jm,irang)=deche
  236. nomdec = lesfac(jm)
  237. imadec = imamod
  238. ICMN=MIN(jm+nobl,NBTYPE)
  239. typdec = type(icmn)
  240. typree = typdec(1:6).eq.'REAL*8'
  241. condec = conmod
  242. ifodec = IFOUR
  243. indec = irang
  244. infdec(1) = 0
  245. infdec(2) = 0
  246. infdec(3) = NIFOUR
  247. infdec(4) = IPMINT
  248. infdec(5) = 0
  249. infdec(6) = lesupp
  250. if(jecree.eq.0.and.dec1.gt.0) then
  251. C segact dec1
  252. ieldec=dec1.ieldec
  253. ** segdes dec1
  254. * write(6,*) 'dec fac rep', nomdec, ieldec, deche,condec
  255. go to 346
  256. endif
  257. if (type(icmn)(1:6).eq.'REAL*8') then
  258. N1PTEL=NBPTEL
  259. N1EL =NEL
  260. N2PTEL=0
  261. N2EL =0
  262. else
  263. N2PTEL=NBPTEL
  264. N2EL =NEL
  265. N1PTEL=0
  266. N1EL =0
  267. endif
  268. *
  269. segini melval
  270. * write(6,*) 'cree fac',cmatee,nomdec,melvaln1ptel,n1el,condec
  271. ieldec = melval
  272. 346 continue
  273. 31 continue
  274.  
  275. 50 CONTINUE
  276. segsup notype
  277. *
  278. if (iilcon.ne.ijlcon) then
  279. iilcon=ijlcon
  280. segadj lilcon
  281. endif
  282.  
  283. END
  284.  
  285.  
  286.  
  287.  

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