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

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