Télécharger hhobsg.eso

Retour à la liste

Numérotation des lignes :

hhobsg
  1. C HHOBSG SOURCE OF166741 24/06/19 21:15:04 11942
  2. C HHOBSG SOURCE FANDEUR
  3.  
  4. C----------------------------------------------------------------------*
  5. C Elements massifs HHO en FORMULATION 'MECANIQUE'
  6. C HHO calcul des efforts internes (B.Sigma)
  7. C----------------------------------------------------------------------*
  8.  
  9. SUBROUTINE HHOBSG(imoHHO, nmoFOR, IVASTR, NCSTR,
  10. & IIPDPG, ADPG,BDPG,CDPG,
  11. & IVACAR, NCARR, IPMINT, NBPTEL,
  12. & ichDEP, ICHBSG, iret)
  13.  
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC CCREEL
  20.  
  21. -INC CCHHOPA
  22. -INC CCHHOPR
  23.  
  24. -INC SMCHAML
  25. c* si besoin des coordonnees -INC SMCOORD
  26. -INC SMCHPOI
  27. -INC SMELEME
  28. -INC SMMODEL
  29. -INC SMINTE
  30. -INC SMLENTI
  31. POINTEUR mlent4.mlenti, mlenPF.mlenti
  32. -INC SMLMOTS
  33. -INC SMLREEL
  34. POINTEUR mlrdef.mlreel, mlrdec.mlreel, mlrmbh.mlreel
  35.  
  36. SEGMENT MPTVAL
  37. INTEGER IPOS(NS),NSOF(NS)
  38. INTEGER IVAL(NCOSOU)
  39. CHARACTER*16 TYVAL(NCOSOU)
  40. ENDSEGMENT
  41.  
  42. SEGMENT MWKHHO
  43. INTEGER TABINT(NBINT)
  44. REAL*8 TABFLO(NBFLO)
  45. ENDSEGMENT
  46.  
  47. LOGICAL B_GDEF, b_z
  48. CHARACTER*(LOCHAI) chaHHO
  49.  
  50. EXTERNAL LONG
  51.  
  52. iret = 0
  53.  
  54. NDPGE = 0
  55. ADPG = XZero
  56. BDPG = XZero
  57. CDPG = XZero
  58.  
  59. imodel = imoHHO
  60. c* segact,imodel <- actif en entree/sortie
  61.  
  62. C- Premieres verifications :
  63. CALL HHONOB(imoHHO, nobHHO, iret)
  64. IF (nobHHO.LE.0)THEN
  65. write(ioimp,*) 'HHOEPS: IMODEL incorrect (not HHO)'
  66. iret = 5
  67. RETURN
  68. END IF
  69.  
  70. C- Recuperation des donnees de infell en entree
  71. c* MELE = imodel.NEFMOD
  72. c* MFR = imodel.infele(13)
  73. meleme = imodel.IMAMOD
  74. NBNOE = meleme.NUM(/1)
  75. NBELT = meleme.NUM(/2)
  76.  
  77. iva = imodel.IVAMOD(nobHHO)
  78. CALL QUEVAL(iva,'MOT ',iret,lenHHO,r_z,chaHHO,b_z,i_z)
  79. B_GDEF = chaHHO(8:10).EQ.'_ft'
  80. *AV B_GDEF = chaHHO(10:12).EQ.'_ft'
  81. c-dbg write(ioimp,*) 'HHOBSG : je suis ici '//chaHHO(1:lenHHO),B_GDEF
  82.  
  83. mlenti = imodel.IVAMOD(nobHHO+1)
  84. c* segact,mlenti
  85. mlent2 = imodel.IVAMOD(nobHHO+2)
  86. c* segact,mlent2
  87. mlent3 = imodel.IVAMOD(nobHHO+3)
  88. c* segact,mlent3
  89. mlent4 = imodel.IVAMOD(nobHHO+4)
  90. c* segact,mlent4
  91.  
  92. n_d_face = mlenti.lect(3)
  93. n_d_cell = mlenti.lect(5)
  94. nb_faces = mlenti.lect(7)
  95. NBPGAU = mlenti.lect(8)
  96. idifo = mlenti.lect(9)
  97. NBDDL = mlenti.lect(11)
  98. NFORF = idifo * n_d_face
  99. NFORC = idifo * n_d_cell
  100. lhook = 9
  101.  
  102. nbel2 = mlent2.lect(/1) / 2
  103. nbel3 = mlent3.lect(/1) / 2
  104. nbfa3 = 2 * nb_faces
  105. nbel4 = mlent4.lect(/1) / 2
  106.  
  107. IF (mlenti.lect(6).NE.NBNOE) THEN
  108. write(ioimp,*) 'HHOBSG: Bizarre nb_vertices'
  109. END IF
  110. IF (NBDDL .NE. imodel.INFELE(9)) then
  111. write(ioimp,*) 'HHOBSG: Bizarre NBDDL'
  112. END IF
  113. c NBPGAU =? (NBPTEL = imodel.INFELE(4))
  114. IF (NBPGAU .NE. imodel.INFELE(4)) then
  115. write(ioimp,*) 'HHOBSG: Bizarre nb.p.gau(1)'
  116. END IF
  117. c NBPGAU =? minte.POIGAU(/1)
  118. minte = IPMINT
  119. c* SEGACT minte <- actif en E/S
  120. if (NBPGAU .NE. minte.POIGAU(/1)) then
  121. write(ioimp,*) 'HHOBSG: Bizarre nb.p.gau (2)'
  122. end if
  123. c-dbg write(ioimp,*) 'HHOBSG nbpgau=',NBPGAU
  124. c-dbg write(ioimp,*) 'HHOBSG: dof face/cell',n_d_face,n_d_cell,nb_faces
  125. if (nbel3.NE.(NBELT*nb_faces)) then
  126. write(ioimp,*) 'HHOBSG: Bizarre nbel3'
  127. end if
  128. if (nbel4.NE.NBELT) then
  129. write(ioimp,*) 'HHOBSG: Bizarre nbel4'
  130. end if
  131.  
  132. C- Verification des caracteristiques :
  133. mptval = IVACAR
  134. IVPIHO = mptval.IVAL(NCARR-1)
  135. melval = IVPIHO
  136. IGPI = melval.VELCHE(/1)
  137. IEPI = melval.VELCHE(/2)
  138. c-dbg write(ioimp,*) 'IVPIHO',melval,igpi,iepi,tyval(ncarr-1)
  139. IF (IGPI.NE.NBPGAU .AND. IGPI.NE.1) THEN
  140. write(ioimp,*) 'HHOBSG: PIHO vector size incorrect'
  141. iret = 21
  142. RETURN
  143. END IF
  144. IVMBHO = mptval.IVAL(NCARR)
  145. melval = IVMBHO
  146. IGMB = melval.IELCHE(/1)
  147. IEMB = melval.IELCHE(/2)
  148. c-dbg write(ioimp,*) 'IVMBHO',melval,igmb,iemb,tyval(ncarr)
  149. mlrmbh = melval.IELCHE(1,1)
  150. c* segact,mlrmbh
  151. c* write(ioimp,*) 'HHOBSG MBHHO SIZE:',mlrmbh.prog(/1),
  152. c* & NBDDL,9*NBDDL,mlenti.lect(14)
  153. IF ((mlrmbh.prog(/1).NE.(9*NBDDL)) .OR.
  154. & (mlrmbh.prog(/1).NE.mlenti.lect(14))) THEN
  155. write(ioimp,*) 'HHOBSG: BHHO matrix size incorrect'
  156. iret = 21
  157. RETURN
  158. END IF
  159.  
  160. C- Forces des faces et des cellules :
  161. nomid = nmoFOR
  162. c segact,nomid
  163. c-dbg write(ioimp,*) 'HHOBSG=',NFORC,NFORF,lesobl(/2),lesfac(/2)
  164. nfac = 0
  165. JGN = nomid.lesobl(/1)
  166.  
  167. C- Le chapeau du champ point de forces interieures
  168. NAT = 2
  169. NSOUPO = 2
  170. SEGINI,MCHPOI
  171. mchpoi.MTYPOI = 'FORCES '
  172. mchpoi.MOCHDE = ' '
  173. mchpoi.JATTRI(1) = 2
  174. mchpoi.JATTRI(2) = 0
  175. mchpoi.IFOPOI = IFOUR
  176. ICHBSG = MCHPOI
  177.  
  178. C- 2 sous-zones : les points supports des cellules et des faces
  179. NC = NFORC
  180. N = nbel4
  181. SEGINI,MSOUP1
  182. SEGINI,MPOVA1
  183. DO i = 1, NC
  184. msoup1.NOCOMP(i) = ' '
  185. msoup1.NOCOMP(i)(1:JGN) = nomid.lesobl(i)(1:JGN)
  186. msoup1.NOHARM(i) = 0
  187. END DO
  188. msoup1.IPOVAL = MPOVA1
  189. CALL HHOMPO('CELL',mlent4,IPT1)
  190. msoup1.IGEOC = IPT1
  191. mchpoi.IPCHP(1) = MSOUP1
  192.  
  193. NC = NFORF
  194. N = nbel2
  195. SEGINI,MSOUP2
  196. SEGINI,MPOVA2
  197. DO i = 1, NC
  198. msoup2.NOCOMP(i) = ' '
  199. msoup2.NOCOMP(i)(1:JGN) = nomid.lesobl(NFORC+i)(1:JGN)
  200. msoup2.NOHARM(i) = 0
  201. END DO
  202. msoup2.IPOVAL = MPOVA2
  203. CALL HHOMPO('FACE',mlent2,IPT2)
  204. msoup2.IGEOC = IPT2
  205. mchpoi.IPCHP(2) = MSOUP2
  206.  
  207. C- La liste mlenPF devrait etre initialisee une seule fois et remplie
  208. CALL HHOMPO('LGFA',mlent2,mlenPF)
  209. IPT4 = MPFHHO
  210. c segact,ipt4
  211.  
  212. C- Le modele est en grandes deformations : Il donc transporter le
  213. C- tenseur des contraintes (de Cauchy SIGC) sur la geometrie initiale
  214. C- (tenseur de Piola-Kirchhoff 1 = PK1) PK1 = SIGC.[det(F).inv(transF)]
  215. IF ( B_GDEF ) THEN
  216. NDEPC = NFORC
  217. NDEPF = NFORF
  218. nomid = imodel.LNOMID(1)
  219. if (nomid.eq.0) then
  220. write(ioimp,*) 'HHOBSG - IMODEL - MODEPL incorrect'
  221. iret = 5
  222. return
  223. end if
  224. c* segact,nomid
  225. JGN = nomid.lesobl(/1)
  226. ivid = 1
  227. C- Deplacements des faces et des cellules :
  228. c-dbg write(ioimp,*) 'HHOBSG=',NDEPC,NDEPF,lesobl(/2),lesfac(/2)
  229. nfac = 0
  230. C Deplacements des cellules - Points supports des cellules
  231. JGM = NDEPC + nfac
  232. SEGINI,mlmots
  233. DO i = 1, NDEPC
  234. mlmots.MOTS(i)(1:JGN) = nomid.lesobl(i)(1:JGN)
  235. END DO
  236. CALL EXTR23(ichDEP,mlmots,MPCHHO,mlrDEC,ivid)
  237. SEGACT,mlrDEC
  238. C Deplacements des faces - Points supports des faces
  239. JGM = NDEPF + nfac
  240. SEGADJ,mlmots
  241. DO i = 1, NDEPF
  242. mlmots.MOTS(i)(1:JGN) = nomid.lesobl(NDEPC+i)(1:JGN)
  243. END DO
  244. CALL EXTR23(ichDEP,mlmots,MPFHHO,mlrDEF,ivid)
  245. SEGACT,mlrDEF
  246. END IF
  247.  
  248. C- Indices et tableau de travail
  249. ir_coo = 0
  250. c* si besoin des coordonnees ir_sig = ir_coo + (IDIM*NBNOE)
  251. ir_sig = ir_coo + 0
  252. c* si besoin des contraintes ir_fce = ir_sig + lhook
  253. ir_fce = ir_sig + 0
  254. ir_ffa = ir_fce + NFORC
  255. ir_fge = ir_ffa + (NFORF*nb_faces)
  256. ir_fin = ir_fge + NDPGE
  257. IF (B_GDEF) THEN
  258. ir_gra = ir_fin
  259. c* si besoin des gradients ir_uce = ir_gra + lhook
  260. ir_uce = ir_gra + 0
  261. ir_ufa = ir_uce + NDEPC
  262. ir_uge = ir_ufa + (NDEPF*nb_faces)
  263. ir_fin = ir_uge + NDPGE
  264. END IF
  265.  
  266. NBINT = nb_faces
  267. NBFLO = ir_fin
  268. SEGINI,MWKHHO
  269.  
  270. C Pour l'instant NDPGE = 0, a recuperer dans ichDEP ?
  271. IF (NDPGE.GT.0) THEN
  272. DO ic = 1, NDPGE
  273. ccc? TABFLO(ir_fge+ic) = XZero
  274. ccc? TABFLO(ir_uge+ic) = A recuperer dans ichDEP
  275. END DO
  276. END IF
  277. c* si besoin des coordonnees SEGACT,mcoord*nomod
  278.  
  279. C-------------------------
  280. C Boucle sur les elements
  281. C-------------------------
  282. DO IEL = 1, NBELT
  283.  
  284. C- Recuperation des coordonnees des noeuds de l element IEL
  285. c* CALL HHOCOO(meleme.num,NBNOE, mcoord.xcoor, IEL,
  286. c* & TABFLO(ir_coo+1), iret)
  287. c* IF (iret.NE.0) RETURN
  288.  
  289. C- Reperage des faces :
  290. in1 = (IEL-1) * nbfa3
  291. DO j1 = 1, nb_faces
  292. in2 = in1 + (2 * j1)
  293. je = mlent3.lect(in2-1)
  294. ip = ABS(mlent3.lect(in2))
  295. c-dbg if (ip.eq.0) write(ioimp,*) 'HHOEPS IFAE Bizarre...',iel,j1,je,ip
  296. TABINT(j1) = ip + NBFHHO(je-1)
  297. END DO
  298. C- Remise a zero des forces
  299. DO jc = ir_fce+1, ir_fge
  300. TABFLO(jc) = XZero
  301. END DO
  302. C- Valeurs des inconnues primales pour l'element IEL (cell+faces)
  303. IF (B_GDEF) THEN
  304. in1 = IEL * 2
  305. je = mlent4.lect(in1-1)
  306. ip = mlent4.lect(in1)
  307. c-dbg if (ip.le.0) write(ioimp,*) 'HHOBSG ICEL Bizarre...',iel,je,ip
  308. jp = ip + NBCHHO(je-1)
  309. c-dbg write(ioimp,*) 'HHOBSG ICEL :',iel,je,ip,jp
  310. c-dbg write(ioimp,*) 'HHOBSG :',NDEPC,NCEHHO,ir_uce
  311. c-dbg write(ioimp,*) 'HHOBSG :',NDEPF,NFAHHO,ir_ufa
  312. DO ic = 1, NDEPC
  313. jc = NCEHHO * (ic - 1)
  314. c-dbg write(ioimp,*) 'HHOBSG ic:',ic,jc,jp,mlrDEC.prog(/1),
  315. c-dbg & TABFLO(/1),ir_uce+ic,jp+jc
  316. TABFLO(ir_uce + ic) = mlrDEC.prog(jp + jc)
  317. END DO
  318. ir_kc = ir_ufa
  319. DO j1 = 1, nb_faces
  320. jp = TABINT(j1)
  321. DO ic = 1, NDEPF
  322. jc = NFAHHO * (ic - 1)
  323. TABFLO(ir_kc + ic) = mlrDEF.prog(jp + jc)
  324. END DO
  325. ir_kc = ir_kc + NDEPF
  326. END DO
  327. END IF
  328.  
  329. JEPI = MIN(IEL,IEPI)
  330. JEMB = MIN(IEL,IEMB)
  331. C-- -- -- -- -- -- -- -- --
  332. C - Boucle sur les points de Gauss
  333. C-- -- -- -- -- -- -- -- --
  334. DO IGAU = 1, NBPGAU
  335.  
  336. melval = IVPIHO
  337. JGPI = MIN(IGAU,IGPI)
  338. pgau = melval.VELCHE(JGPI,JEPI)
  339.  
  340. melval = IVMBHO
  341. JGMB = MIN(IGAU,IGMB)
  342. mlrmbh = melval.IELCHE(JGMB,JEMB)
  343. c* segact,mlrmbh
  344. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  345.  
  346. C -- Recuperation des "contraintes" de Cauchy
  347. mptval = IVASTR
  348. C -- Contraintes "Diagonales" SIG(11,22,33)
  349. melval = mptval.IVAL(1)
  350. IEMN = MIN(IEL ,melval.VELCHE(/1))
  351. IGMN = MIN(IGAU,melval.VELCHE(/2))
  352. SIGC11 = melval.velche(IGMN,IEMN)
  353. melval = mptval.IVAL(2)
  354. IEMN = MIN(IEL ,melval.VELCHE(/1))
  355. IGMN = MIN(IGAU,melval.VELCHE(/2))
  356. SIGC22 = melval.velche(IGMN,IEMN)
  357. melval = mptval.IVAL(3)
  358. IEMN = MIN(IEL ,melval.VELCHE(/1))
  359. IGMN = MIN(IGAU,melval.VELCHE(/2))
  360. SIGC33 = melval.velche(IGMN,IEMN)
  361. C -- Contraintes de cisaillement SIG(12,13,23)
  362. melval = mptval.IVAL(4)
  363. IEMN = MIN(IEL ,melval.VELCHE(/1))
  364. IGMN = MIN(IGAU,melval.VELCHE(/2))
  365. SIGC12 = melval.velche(IGMN,IEMN)
  366. IF (NCSTR.GT.4) THEN
  367. melval = mptval.IVAL(5)
  368. IEMN = MIN(IEL ,melval.VELCHE(/1))
  369. IGMN = MIN(IGAU,melval.VELCHE(/2))
  370. SIGC13 = melval.velche(IGMN,IEMN)
  371. melval = mptval.IVAL(6)
  372. IEMN = MIN(IEL ,melval.VELCHE(/1))
  373. IGMN = MIN(IGAU,melval.VELCHE(/2))
  374. SIGC23 = melval.velche(IGMN,IEMN)
  375. ELSE
  376. SIGC13 = XZero
  377. SIGC23 = XZero
  378. END IF
  379. SIGC21 = SIGC12
  380. SIGC31 = SIGC13
  381. SIGC32 = SIGC23
  382.  
  383. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  384. IF ( B_GDEF ) THEN
  385. C- Il faut calculer le tenseurs des contraintes de Piola-Kirchhoff 1
  386. C- F = gradient_transformation
  387. F11 = 1.D0
  388. F22 = 1.D0
  389. F33 = 1.D0
  390. F12 = XZero
  391. F21 = XZero
  392. F13 = XZero
  393. F31 = XZero
  394. F23 = XZero
  395. F32 = XZero
  396. DO jc = 1, NBDDL
  397. jnc = lhook * (jc-1)
  398. r_z = TABFLO(ir_uce + jc)
  399. F11 = F11 + mlrmbh.prog(1 + jnc) * r_z
  400. F22 = F22 + mlrmbh.prog(2 + jnc) * r_z
  401. F33 = F33 + mlrmbh.prog(3 + jnc) * r_z
  402. F12 = F12 + mlrmbh.prog(4 + jnc) * r_z
  403. F21 = F21 + mlrmbh.prog(5 + jnc) * r_z
  404. F13 = F13 + mlrmbh.prog(6 + jnc) * r_z
  405. F31 = F31 + mlrmbh.prog(7 + jnc) * r_z
  406. F23 = F23 + mlrmbh.prog(8 + jnc) * r_z
  407. F32 = F32 + mlrmbh.prog(9 + jnc) * r_z
  408. END DO
  409. c- DIFT = det(F).inv(trans(F))
  410. DIFT11 = F22*F33 - F32*F23
  411. DIFT12 = F31*F23 - F21*F33
  412. DIFT13 = F21*F32 - F31*F22
  413. DIFT21 = F32*F13 - F12*F33
  414. DIFT22 = F11*F33 - F31*F13
  415. DIFT23 = F31*F12 - F11*F32
  416. DIFT31 = F12*F23 - F22*F13
  417. DIFT32 = F21*F13 - F11*F23
  418. DIFT33 = F11*F22 - F21*F12
  419. c- Contraintes de Piola-Kirchhoff 1 : PIKU = SIGC.DIFT
  420. PIKU11 = SIGC11 * DIFT11 + SIGC12 * DIFT21 + SIGC13 * DIFT31
  421. PIKU22 = SIGC21 * DIFT12 + SIGC22 * DIFT22 + SIGC23 * DIFT32
  422. PIKU33 = SIGC31 * DIFT13 + SIGC32 * DIFT23 + SIGC33 * DIFT33
  423. PIKU12 = SIGC11 * DIFT12 + SIGC12 * DIFT22 + SIGC13 * DIFT32
  424. PIKU21 = SIGC21 * DIFT11 + SIGC22 * DIFT21 + SIGC23 * DIFT31
  425. PIKU13 = SIGC11 * DIFT13 + SIGC12 * DIFT23 + SIGC13 * DIFT33
  426. PIKU31 = SIGC31 * DIFT11 + SIGC32 * DIFT21 + SIGC33 * DIFT31
  427. PIKU23 = SIGC21 * DIFT13 + SIGC22 * DIFT23 + SIGC23 * DIFT33
  428. PIKU32 = SIGC31 * DIFT12 + SIGC32 * DIFT22 + SIGC33 * DIFT32
  429. c* !! matrice BHHO stockee colonne par colonne : lhook*NBDDL
  430. DO jc = 1, NBDDL
  431. jnc = lhook * (jc-1)
  432. r_z = mlrmbh.prog(1 + jnc) * PIKU11
  433. & + mlrmbh.prog(2 + jnc) * PIKU22
  434. & + mlrmbh.prog(3 + jnc) * PIKU33
  435. & + mlrmbh.prog(4 + jnc) * PIKU12
  436. & + mlrmbh.prog(5 + jnc) * PIKU21
  437. IF (NCSTR.GT.4) THEN
  438. r_z = r_z + mlrmbh.prog(6 + jnc) * PIKU13
  439. & + mlrmbh.prog(7 + jnc) * PIKU31
  440. & + mlrmbh.prog(8 + jnc) * PIKU23
  441. & + mlrmbh.prog(9 + jnc) * PIKU32
  442. END IF
  443. TABFLO(ir_fce + jc) = TABFLO(ir_fce + jc) + pgau * r_z
  444. END DO
  445. ELSE
  446. DO jc = 1, NBDDL
  447. jnc = lhook * (jc-1)
  448. r_z = mlrmbh.prog(1 + jnc) * SIGC11
  449. & + mlrmbh.prog(2 + jnc) * SIGC22
  450. & + mlrmbh.prog(3 + jnc) * SIGC33
  451. & + mlrmbh.prog(4 + jnc) * SIGC12
  452. & + mlrmbh.prog(5 + jnc) * SIGC21
  453. IF (NCSTR.GT.4) THEN
  454. r_z = r_z + mlrmbh.prog(6 + jnc) * SIGC13
  455. & + mlrmbh.prog(7 + jnc) * SIGC31
  456. & + mlrmbh.prog(8 + jnc) * SIGC23
  457. & + mlrmbh.prog(9 + jnc) * SIGC32
  458. END IF
  459. TABFLO(ir_fce + jc) = TABFLO(ir_fce + jc) + pgau * r_z
  460. END DO
  461. END IF
  462.  
  463. C-- -- -- -- -- -- -- -- --
  464. END DO
  465. C-- -- -- -- -- -- -- -- --
  466.  
  467. C Pour les cellules
  468. c-dbg write(ioimp,*) 'mpova1',iel,NBELT,nbel4,ir_fce
  469. DO ic = 1, NFORC
  470. mpova1.VPOCHA(IEL,ic) = mpova1.VPOCHA(IEL,ic)
  471. & + TABFLO(ir_fce + ic)
  472. END DO
  473. C Pour les faces
  474. ir_kc = ir_ffa
  475. DO j1 = 1, nb_faces
  476. jp = TABINT(j1)
  477. kp = ipt4.num(1,jp)
  478. IFA = mlenPF.lect(kp)
  479. c-dbg write(ioimp,*) 'mpova2',iel,j1,nb_faces,kp,IFA,nbel2,ir_kc
  480. DO ic = 1, NFORF
  481. mpova2.VPOCHA(IFA,ic) = mpova2.VPOCHA(IFA,ic)
  482. & + TABFLO(ir_kc + ic)
  483. END DO
  484. ir_kc = ir_kc + NFORF
  485. END DO
  486.  
  487. C-------------------------
  488. END DO
  489. C-------------------------
  490. SEGSUP,MWKHHO
  491. SEGSUP,mlenPF
  492. IF ( B_GDEF ) THEN
  493. SEGSUP,mlrDEC,mlrDEF
  494. SEGSUP,mlmots
  495. END IF
  496.  
  497. c* RETURN
  498. END
  499.  
  500.  
  501.  
  502.  

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