Télécharger jacopo.eso

Retour à la liste

Numérotation des lignes :

  1. C JACOPO SOURCE CB215821 19/07/30 21:17:01 10273
  2. SUBROUTINE JACOPO(IPMODL,IPCHE,IRET)
  3. C=======================================================================
  4. C ENTREES :
  5. C ---------
  6. C IPMODL= pointeur sur un MMODEL
  7. C
  8. C SORTIES :
  9. C --------
  10. C
  11. C IPCHE = CHAMELEM contenant les JACOBIENS
  12. C IRET = 1 si succes 0 sinon
  13. C
  14. C Passage au nouveau Chamelem PAR S.RAMAHANDRY le 11/09/90
  15. C CB215821 20/03/2017 : Ajout de la formulation DIFFUSION (MFR=73)
  16. C=====================================================================
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19. PARAMETER(UN=1.D0,XZER=0.D0)
  20. -INC CCOPTIO
  21. -INC CCHAMP
  22. -INC SMCHAML
  23. -INC SMMODEL
  24. -INC SMELEME
  25. -INC SMCOORD
  26. -INC SMINTE
  27. C
  28. SEGMENT TRA
  29. REAL*8 XEL(3,NBNN) ,SHP(6,NBNN) ,XE(3,NBNN) ,BPSS(3,3)
  30. ENDSEGMENT
  31. C
  32. SEGMENT TR1
  33. REAL*8 TH(NBN1) ,TXR(3,3,NBN1) ,XJ(3,3)
  34. ENDSEGMENT
  35. C
  36. SEGMENT INFO
  37. INTEGER INFELL(JG)
  38. ENDSEGMENT
  39. C
  40. SEGMENT MPTVAL
  41. INTEGER IPOS(NS) , NSOF(NS)
  42. INTEGER IVAL(NCOSOU)
  43. CHARACTER*16 TYVAL(NCOSOU)
  44. ENDSEGMENT
  45. C
  46. DIMENSION BPSS(3,3)
  47. CHARACTER*8 CMATE
  48. C
  49. NHRM = NIFOUR
  50. IRET = 1
  51. C
  52. C ACTIVATION DU MODELE
  53. C
  54. MMODEL= IPMODL
  55. NSOUS = KMODEL(/1)
  56. C
  57. C CREATION DU MCHELM
  58. C
  59. N1= NSOUS
  60. L1= 8
  61. N3= 6
  62. SEGINI,MCHELM
  63. IPCHE =MCHELM
  64. TITCHE='SCALAIRE'
  65. IFOCHE=IFOUR
  66. C____________________________________________________________________
  67. C
  68. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  69. C____________________________________________________________________
  70. C
  71. DO 500 ISOUS=1,NSOUS
  72. C
  73. C ON RECUPERE L INFORMATION GENERALE
  74. C
  75. IMODEL=KMODEL(ISOUS)
  76. IPMAIL=IMAMOD
  77. IMACHE(ISOUS)=IPMAIL
  78. CONCHE(ISOUS)=CONMOD
  79. C
  80. C TRAITEMENT DU MODELE
  81. C
  82. MELE = NEFMOD
  83. MELEME= IMAMOD
  84. C NFOR = FORMOD(/2)
  85. C NMAT = MATMOD(/2)
  86. C____________________________________________________________________
  87. C
  88. C INFORMATION SUR L'ELEMENT FINI
  89. C____________________________________________________________________
  90. C
  91. if(infmod(/1).lt.7) then
  92. CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  93. IF (IERR.NE.0) THEN
  94. SEGSUP,MCHELM
  95. IRET=0
  96. RETURN
  97. ENDIF
  98.  
  99. INFO=IPINF
  100. MELE = INFELL(1)
  101. MFR = INFELL(13)
  102. MINTE = INFELL(11)
  103. MINTE1= INFELL(12)
  104. segsup,info
  105. else
  106. MELE =INFELE(1)
  107. MFR =INFELE(13)
  108. MINTE=INFMOD(7)
  109. MINTE1=INFMOD(8)
  110. endif
  111. C
  112. INFCHE(ISOUS,1)= 0
  113. INFCHE(ISOUS,2)= 0
  114. INFCHE(ISOUS,3)= NHRM
  115. INFCHE(ISOUS,4)= MINTE
  116. INFCHE(ISOUS,5)= 0
  117. INFCHE(ISOUS,6)= 5
  118. C
  119. C INITIALISATION DE MINTE
  120. C
  121. NBPGAU=POIGAU(/1)
  122. C
  123. C ACTIVATION DU MELEME
  124. C
  125. NBNN =NUM(/1)
  126. NBELEM=NUM(/2)
  127. C
  128. C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  129. C
  130. N1PTEL=NBPGAU
  131. N1EL=NBELEM
  132. C
  133. C CREATION DU MCHAML DE LA SOUS ZONE
  134. C
  135. NJAC=1
  136. N2 =1
  137. SEGINI,MCHAML
  138. ICHAML(ISOUS)=MCHAML
  139. NS=1
  140. NCOSOU=NJAC
  141. SEGINI MPTVAL
  142. IVAJAC=MPTVAL
  143. C
  144. C 1 COMPOSANTE
  145. C
  146. ICOMP = 1
  147. NOMCHE(ICOMP)='SCAL '
  148. TYPCHE(ICOMP)='REAL*8'
  149. N2PTEL = 0
  150. N2EL = 0
  151. SEGINI,MELVAL
  152. IELVAL(ICOMP)= MELVAL
  153. IVAL(ICOMP) = MELVAL
  154. C
  155. C ERREUR FORMULATION INDISPONIBLE
  156. C
  157. IF(MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9.OR.MFR.EQ.7
  158. 1 .OR.MFR.EQ.13.OR.MFR.EQ.33.OR.MFR.EQ.35.OR.MFR.EQ.73)
  159. 1 GOTO 44
  160. MOTERR(1:8)=NOMFR(MFR)
  161. CALL ERREUR(193)
  162. IRET=0
  163. GOTO 9990
  164. C
  165. 44 CONTINUE
  166. C
  167. SEGINI,TRA
  168. C
  169. C ================== FORMULATION JOINT =======================
  170. C
  171. C ----------------- Element JOT3
  172. C
  173. IF(MFR.EQ.35) THEN
  174. IF(MELE.EQ.87) THEN
  175. DO 9000 IB=1,NBELEM
  176. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  177. DO 9002 IC=1,NBPGAU
  178. DO 9003 ID=1,6
  179. DO 9003 IE=1,NBNN
  180. SHP(ID,IE)=SHPTOT(ID,IE,IC)
  181. 9003 CONTINUE
  182.  
  183. CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  184. IF (NOQUAL.EQ.1) THEN
  185. INTERR(1)=IB
  186. MOTERR(1:4)='JOT3'
  187. CALL ERREUR(765)
  188. RETURN
  189. ELSE IF(NOQUAL.EQ.2) THEN
  190. INTERR(1)=IB
  191. MOTERR(1:4)='JOT3'
  192. CALL ERREUR(766)
  193. RETURN
  194. ENDIF
  195.  
  196. NBNONN=NBNN/2
  197. CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOUR,NIFOUR,2,1.D0,RR,DJAC)
  198. IRRT = 0
  199. IF (DJAC.LT.XZER) THEN
  200. IRRT = 1
  201. ELSE IF(DJAC.EQ.XZER) THEN
  202. IRRT = 2
  203. ENDIF
  204. IF(IRRT.NE.0) THEN
  205. CALL ERREUR(764)
  206. RETURN
  207. ENDIF
  208.  
  209. MPTVAL=IVAJAC
  210. MELVAL = IVAL(1)
  211. IBMN=MIN(IB, VELCHE(/2))
  212. IGMN=MIN(IC, VELCHE(/1))
  213. VELCHE(IGMN,IBMN)=ABS(DJAC)
  214. 9002 CONTINUE
  215. 9000 CONTINUE
  216. C
  217. C ----------------- Element JOI4
  218. C
  219. ELSE IF (MELE.EQ.88) THEN
  220. DO 8000 IB=1,NBELEM
  221. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  222. DO 8002 IC=1,NBPGAU
  223. DO 8003 ID=1,6
  224. DO 8003 IE=1,NBNN
  225. SHP(ID,IE)=SHPTOT(ID,IE,IC)
  226. 8003 CONTINUE
  227.  
  228. CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  229. IF (NOQUAL.EQ.1) THEN
  230. INTERR(1)=IB
  231. MOTERR(1:4)='JOI4'
  232. CALL ERREUR(765)
  233. RETURN
  234. ELSE IF(NOQUAL.EQ.2) THEN
  235. INTERR(1)=IB
  236. MOTERR(1:4)='JOI4'
  237. CALL ERREUR(766)
  238. RETURN
  239. ENDIF
  240.  
  241. NBNONN=NBNN/2
  242. CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOUR,NIFOUR,2,1.D0,RR,DJAC)
  243. IRRT = 0
  244. IF (DJAC.LT.XZER) THEN
  245. IRRT = 1
  246. ELSE IF(DJAC.EQ.XZER) THEN
  247. IRRT = 2
  248. ENDIF
  249. IF(IRRT.NE.0) THEN
  250. CALL ERREUR(764)
  251. RETURN
  252. ENDIF
  253.  
  254. MPTVAL=IVAJAC
  255. MELVAL = IVAL(1)
  256. IBMN=MIN(IB, VELCHE(/2))
  257. IGMN=MIN(IC, VELCHE(/1))
  258. VELCHE(IGMN,IBMN)=ABS(DJAC)
  259. 8002 CONTINUE
  260. 8000 CONTINUE
  261.  
  262. ELSE
  263. CALL ERREUR(767)
  264. RETURN
  265. ENDIF
  266.  
  267.  
  268.  
  269. C
  270. C ================ FORMULATION MASSIVE =======================
  271. C
  272. C
  273. ELSE IF(MFR.EQ.1.OR.MFR.EQ.33.OR.MFR.EQ.73) THEN
  274. DO 1000 IB=1,NBELEM
  275. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  276. DO 1002 IC=1,NBPGAU
  277. DO 1003 ID=1,6
  278. DO 1003 IE=1,NBNN
  279. SHP(ID,IE)=SHPTOT(ID,IE,IC)
  280. 1003 CONTINUE
  281. CALL JACOBI(XE,SHP,IDIM,NBNN,DJAC)
  282. MPTVAL=IVAJAC
  283. MELVAL = IVAL(1)
  284. IBMN=MIN(IB, VELCHE(/2))
  285. IGMN=MIN(IC, VELCHE(/1))
  286. VELCHE(IGMN,IBMN)=ABS(DJAC)
  287. 1002 CONTINUE
  288. 1000 CONTINUE
  289. GOTO 520
  290. C
  291. C ================ FORMULATION COQUE MINCE =====================
  292. C
  293. C
  294. ELSE IF(MFR.EQ.3.OR.MFR.EQ.9) THEN
  295. IDI2=IDIM-1
  296. DO 3000 IB=1,NBELEM
  297. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  298. C
  299. IF(IDIM.EQ.2)THEN
  300. CALL VPAST2(XE,BPSS)
  301. ELSE IF(IDIM.EQ.3) THEN
  302. CALL VPAST(XE,BPSS)
  303. ENDIF
  304. CALL VCORL1(XE,XEL,BPSS,NBNN)
  305. DO 3002 IC=1,NBPGAU
  306. DO 3003 ID=1,6
  307. DO 3003 IE=1,NBNN
  308. SHP(ID,IE)=SHPTOT(ID,IE,IC)
  309. 3003 CONTINUE
  310. CALL JACOBI(XEL,SHP,IDI2,NBNN,DJAC)
  311. MPTVAL=IVAJAC
  312. MELVAL = IVAL(1)
  313. IBMN=MIN(IB, VELCHE(/2))
  314. IGMN=MIN(IC,VELCHE(/1))
  315. VELCHE(IGMN,IBMN)=ABS(DJAC)
  316. 3002 CONTINUE
  317. 3000 CONTINUE
  318. GOTO 520
  319. C
  320. C ================ FORMULATION POUTRE ET TUYAU ====================
  321. C
  322. C
  323. ELSE IF(MFR.EQ.7.OR.MFR.EQ.13) THEN
  324. IDI2=IDIM-1
  325. DO 7000 IB=1,NBELEM
  326. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  327. C
  328. DO 7002 IC=1,NBPGAU
  329. CALL POUJAC(XE,DJAC)
  330. MPTVAL=IVAJAC
  331. MELVAL = IVAL(1)
  332. IBMN=MIN(IB, VELCHE(/2))
  333. IGMN=MIN(IC, VELCHE(/1))
  334. VELCHE(IGMN,IBMN)=DJAC
  335. 7002 CONTINUE
  336. 7000 CONTINUE
  337. GOTO 520
  338. C
  339. C ================ FORMULATION COQUE EPAISSE ====================
  340. C
  341. C
  342. ELSE IF(MFR.EQ.5) THEN
  343. C NBPGA1=MINTE1.POIGAU(/1)
  344. NBN1 =MINTE1.SHPTOT(/2)
  345. SEGINI,TR1
  346. C
  347. C UNE PETITE HORREUR ON CONSIDERE LES EPAISSEURS CONSTANTES
  348. C
  349. DO 5010 IC=1,NBNN
  350. TH(IC)=UN
  351. 5010 CONTINUE
  352. DO 5000 IB=1,NBELEM
  353. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  354. C
  355. CALL CQ8LOC(XE,NBN1,MINTE1.SHPTOT,TXR,IRR)
  356. C
  357. DO 5002 IC=1,NBPGAU
  358. E=DZEGAU(IC)
  359. CALL COQ8JC(IC,NBN1,E,XE,TH,TXR,SHPTOT,XJ,DJAC,IRR)
  360. MPTVAL=IVAJAC
  361. MELVAL = IVAL(1)
  362. IBMN=MIN(IB, VELCHE(/2))
  363. IGMN=MIN(IC, VELCHE(/1))
  364. VELCHE(IGMN,IBMN)=ABS(DJAC)
  365. 5002 CONTINUE
  366. 5000 CONTINUE
  367. GOTO 520
  368. ENDIF
  369. C---------------------------------------------------------------------
  370. C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  371. C---------------------------------------------------------------------
  372. C
  373. 520 CONTINUE
  374. MPTVAL=IVAJAC
  375. SEGSUP,MPTVAL,TRA
  376. C
  377. 500 CONTINUE
  378. RETURN
  379. C
  380. 9990 CONTINUE
  381. *
  382. C-------------------------------------------------------------------
  383. C ERREUR DANS UNE ZONE , DESACTIVATION ET RETOUR
  384. C-------------------------------------------------------------------
  385. *
  386. *
  387. *
  388. MPTVAL=IVAJAC
  389. SEGSUP,MPTVAL
  390. * SEGSUP INFO
  391. END
  392.  
  393.  
  394.  

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