Télécharger jacopo.eso

Retour à la liste

Numérotation des lignes :

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

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