Télécharger limodl.eso

Retour à la liste

Numérotation des lignes :

limodl
  1. C LIMODL SOURCE MB234859 25/09/08 21:15:49 12358
  2.  
  3. *--------------------------------------------------------------------*
  4. * LECTURE D'UN NOUVEAU MODELE SUR LE FICHIER IURES. *
  5. * *
  6. * Parametres : *
  7. * *
  8. * IURES Numero du fichier de sortie *
  9. * ITLACC Pile contenant les nouveaux MODELEs *
  10. * IMAX1 Nombre de MODELEs dans la pile *
  11. * IFORM Si sauvegarde en format ou non *
  12. * *
  13. * APPELE PAR : LIPIL *
  14. *--------------------------------------------------------------------*
  15.  
  16. SUBROUTINE LIMODL(IURES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC)
  17.  
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8 (A-H,O-Z)
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23.  
  24. -INC SMMODEL
  25. -INC SMLMOTS
  26. -INC SMELEME
  27.  
  28. SEGMENT,ITLACC
  29. INTEGER ITLAC(0)
  30. ENDSEGMENT
  31.  
  32. SEGMENT,MTABE1
  33. INTEGER ITABE1(NM1)
  34. ENDSEGMENT
  35. SEGMENT,MTABE2
  36. CHARACTER*(8) ITABE2(NM2)
  37. ENDSEGMENT
  38. SEGMENT,MTABE3
  39. CHARACTER*(8) ITABE3(NM3)
  40. ENDSEGMENT
  41. SEGMENT,MTABE4
  42. INTEGER ITABE4(NM4)
  43. ENDSEGMENT
  44. SEGMENT,MTABE5
  45. CHARACTER*(8) ITABE5(NM5)
  46. ENDSEGMENT
  47. SEGMENT,MTABE6
  48. CHARACTER*(8) ITABE6(NM6)
  49. ENDSEGMENT
  50. SEGMENT MTAB6B
  51. CHARACTER*(4) ITAB6B(NM6)
  52. ENDSEGMENT
  53. SEGMENT,MTABE7
  54. CHARACTER*(8) ITABE7(NM7)
  55. ENDSEGMENT
  56. SEGMENT,MTABE8
  57. INTEGER ITABE8(NM7)
  58. ENDSEGMENT
  59. SEGMENT MTABE9
  60. INTEGER ITABE9(NM9)
  61. ENDSEGMENT
  62.  
  63. INTEGER IDAN(10)
  64. CHARACTER*16 MOMODL(10)
  65. CHARACTER*8 cma
  66. LOGICAL b_z
  67.  
  68. iimpil = IIMPI
  69. c-dbg iimpil = 1972
  70.  
  71. if (iimpil.eq.1972) write(ioimp,*) 'LIMODEL niveau =',niveau
  72.  
  73. C=================== NIVEAU = 26+ ==========MMODEL avec Pile IMODEL=====
  74. IF (NIVEAU.LE.25) GOTO 9925
  75.  
  76. DO in = 1, 10
  77. IDAN(in) = 0
  78. ENDDO
  79.  
  80. NIDAN = 1
  81.  
  82. DO IEL = 1, IMAX1
  83.  
  84. IRETOU = 0
  85. CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM)
  86. IF (IRETOU.NE.0) RETURN
  87.  
  88. N1 = IDAN(1)
  89. SEGINI,MMODEL
  90.  
  91. IF (N1.GT.0) THEN
  92. IRETOU = 0
  93. CALL LFCDIE(IURES,N1,mmodel.KMODEL,IRETOU,IFORM)
  94. IF (IRETOU.NE.0) RETURN
  95. ENDIF
  96.  
  97. SEGDES,MMODEL
  98. ITLAC(**) = MMODEL
  99.  
  100. ENDDO
  101.  
  102. RETURN
  103.  
  104. C=================== NIVEAU < 26 ==========MMODEL complet===============
  105. 9925 CONTINUE
  106. if (niveau.lt.4) then
  107. write(ioimp,*) 'Attention : Niveau tres ancien (< 4) !!!'
  108. write(ioimp,*) 'Relire puis sauver le fichier avec une ',
  109. & 'version de niveau intermediaire'
  110. call erreur(5)
  111. return
  112. endif
  113.  
  114. NIDAN = 10
  115. if (niveau.lt.15) NIDAN = 7
  116. if (niveau.lt.13) NIDAN = 4
  117.  
  118. * Boucle (10) sur les MODELEs contenus dans la pile :
  119. * -----------
  120. DO 10 IEL = 1, IMAX1
  121.  
  122. c* DO in = 1, NIDAN
  123. DO in = 1, 10
  124. IDAN(in) = 0
  125. ENDDO
  126.  
  127. mtabe1 = 0
  128. mtabe2 = 0
  129. mtabe3 = 0
  130. mtabe4 = 0
  131. mtabe5 = 0
  132. mtabe6 = 0
  133. mtab6b = 0
  134. mtabe7 = 0
  135. mtabe8 = 0
  136. mtabe9 = 0
  137.  
  138. IRETOU = 0
  139.  
  140. CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM)
  141. IF (IRETOU.NE.0) RETURN
  142.  
  143. N1 = IDAN(1)
  144. SEGINI,MMODEL
  145.  
  146. N45 = IDAN(6)
  147. if (niveau.lt.13) then
  148. N45 = 6
  149. if (niveau.lt.12) N45 = 5
  150. endif
  151.  
  152. NM1 = N1 * N45
  153.  
  154. NM2 = IDAN(2)
  155. NM3 = IDAN(3)
  156. NM4 = IDAN(4)
  157.  
  158. NM5 = IDAN(5)
  159. idecmo = 0
  160. IF (N1.gt.0) idecmo = NM5 / N1
  161. if (niveau.lt.13) then
  162. idecmo = 2
  163. NM5 = N1 * idecmo
  164. endif
  165.  
  166. NM6 = IDAN(7)
  167. c* if (niveau.ge.13) then : nm6 lu sinon 0
  168. NM7 = IDAN(8)
  169. c* if (niveau.ge.15) then : nm7 lu sinon 0
  170.  
  171. NM9 = N1 * 16
  172.  
  173. if (iimpil.eq.1972) then
  174. write(ioimp,*) 'N1, N45 = ',N1,n45
  175. write(ioimp,*) 'nm1 nm2 nm3 nm4 nm5 nm6 nm7 nm9'
  176. write(ioimp,*) nm1, nm2 ,nm3, nm4, nm5, nm6, nm7, nm9
  177. endif
  178.  
  179. SEGINI,mtabe1,mtabe2,mtabe3,mtabe9
  180. SEGINI,mtabe4,mtabe5
  181. if (nm6.gt.0) then
  182. SEGINI,mtabe6,mtab6b
  183. endif
  184. if (nm7.gt.0) then
  185. SEGINI,mtabe7,mtabe8
  186. endif
  187.  
  188. CALL LFCDIE(IURES,NM1,itabe1,IRETOU,IFORM)
  189. IF (IRETOU.NE.0) RETURN
  190. if (iimpil.eq.1972) then
  191. write(ioimp,*) ' itabe1 '
  192. write(ioimp,fmt='(10i5)') (itabe1(in),in=1,nm1)
  193. endif
  194. IF (n45.gt.28) then
  195. CALL LFCDIE(IURES,NM9,itabe9,IRETOU,IFORM)
  196. IF (IRETOU.NE.0) RETURN
  197. if (iimpil.eq.1972) then
  198. write(ioimp,*) ' itabe9 '
  199. write(ioimp,fmt='(10i5)') (itabe9(in),in=1,nm9)
  200. endif
  201. ENDIF
  202.  
  203. CALL LFCDIN(IURES,NM5,itabe5,IRETOU,IFORM)
  204. IF (IRETOU.NE.0) RETURN
  205. CALL LFCDIN(IURES,NM2,itabe2,IRETOU,IFORM)
  206. IF (IRETOU.NE.0) RETURN
  207. CALL LFCDIN(IURES,NM3,itabe3,IRETOU,IFORM)
  208. IF (IRETOU.NE.0) RETURN
  209. CALL LFCDIE(IURES,NM4,itabe4,IRETOU,IFORM)
  210. IF (IRETOU.NE.0) RETURN
  211. if (nm6.gt.0) then
  212. if (niveau.ge.14) then
  213. CALL LFCDIN(iures,nm6,itabe6,iretou,IFORM)
  214. IF (IRETOU.NE.0) RETURN
  215. endif
  216. if (niveau.eq.13) then
  217. call lfcden(iures,nm6,itab6b,iretou,IFORM)
  218. if (iretou.ne.0) return
  219. endif
  220. endif
  221. if (nm7.gt.0) then
  222. if (niveau.ge.15) then
  223. if (iimpil.eq.1972) write(ioimp,*) 'nm7 ',nm7
  224. CALL LFCDIN(IURES,NM7,itabe7,IRETOU,IFORM)
  225. if (iimpil.eq.1972) write(ioimp,*) 'itabe7 ',(itabe7(in),in=1,nm7)
  226. if (iretou.ne.0) return
  227. CALL LFCDIE(IURES,NM7,itabe8,IRETOU,IFORM)
  228. if (iimpil.eq.1972) write(ioimp,*) 'itabe8 ',(itabe8(in),in=1,nm7)
  229. if (iretou.ne.0) return
  230. endif
  231. endif
  232.  
  233. * BOUCLE (20) SUR LES ZONES ELEMENTAIRES DU MODELE :
  234. nparmo = 0
  235. nobmod = 0
  236.  
  237. jfor = 0
  238. jmat = 0
  239. jinf = 0
  240. jnomid = 0
  241. jobj = 0
  242.  
  243. DO 20 ISOUEL = 1, N1
  244.  
  245. ISOU = N45 * ( ISOUEL - 1 )
  246.  
  247. NFOR = itabe1(ISOU+3)
  248. NMAT = itabe1(ISOU+4)
  249. if (niveau.ge.13) nparmo = itabe1(isou+10)
  250. if (niveau.ge.15) nobmod = itabe1(isou+11)
  251. if (n45.ge.37) nobmod = itabe1(isou+37)
  252.  
  253. mn3lu = itabe1(ISOU+5)
  254. MN3 = mn3lu
  255. if (n45.lt.28) MN3 = 7
  256. MN3 = MAX(MN3,12)
  257. if (iimpil.eq.1972) write(ioimp,*) ' nparmo MN3',nparmo,MN3
  258.  
  259. SEGINI,IMODEL
  260. mmodel.KMODEL(ISOUEL) = IMODEL
  261.  
  262. imodel.CONMOD = ' '
  263. imodel.IMAMOD = itabe1(ISOU+1)
  264. imodel.NEFMOD = itabe1(ISOU+2)
  265. IF (niveau.GE.20) THEN
  266. imodel.IPDPGE = itabe1(ISOU+6)
  267. ELSE
  268. imodel.IPDPGE = 0
  269. IF (niveau.GE.12) THEN
  270. ii_z = itabe1(ISOU+6)
  271. IF (ii_z.GT.0) THEN
  272. ipt1 = ii_z + NBANC
  273. CALL CRELEM(ipt1)
  274. C On verifie s'il n'a pas deja ete preconditionne.
  275. CALL CRECH1(ipt1,1)
  276. segdes,ipt1
  277. imodel.IPDPGE = ipt1
  278. ENDIF
  279. ENDIF
  280. ENDIF
  281.  
  282. if (n45.ge.38) then
  283. jderiv = itabe1(isou+38)
  284. else
  285. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  286. c jderiv=mepsil
  287. jderiv = 0
  288. endif
  289. imodel.IDERIV = jderiv
  290.  
  291. imodel.CONMOD(1:8) = itabe5(idecmo*(ISOUEL-1)+1)
  292. imodel.CONMOD(9:16) = itabe5(idecmo*(ISOUEL-1)+2)
  293. if (niveau.ge.13) then
  294. imodel.CONMOD(17:24) = itabe5(idecmo*(ISOUEL-1)+3)
  295. endif
  296.  
  297. c* Lecture de la formulation :
  298. DO in = 1, NFOR
  299. jfor = jfor + 1
  300. imodel.FORMOD(in)(1:8) = itabe2(jfor)
  301. jfor = jfor + 1
  302. imodel.FORMOD(in)(9:16) = itabe2(jfor)
  303. ENDDO
  304. DO in = 1, NMAT
  305. jmat = jmat + 1
  306. imodel.MATMOD(in)(1:8) = itabe3(jmat)
  307. jmat = jmat + 1
  308. imodel.MATMOD(in)(9:16) = itabe3(jmat)
  309. ENDDO
  310.  
  311. c* Cas particuliers :
  312. inconv = 0
  313. inraye = 0
  314. do in = 1, NFOR
  315. if (imodel.FORMOD(in).eq.'CONVECTION ' ) then
  316. if (inconv.eq.0) then
  317. inconv = in
  318. NMAT = NMAT+1
  319. SEGADJ,imodel
  320. imodel.FORMOD(in) = 'THERMIQUE '
  321. imodel.MATMOD(NMAT) = 'CONVECTION '
  322. else
  323. write(ioimp,*) 'CONVECTION lue > 1 !!!'
  324. endif
  325. endif
  326. if (imodel.FORMOD(in).eq.'RAYONNEMENT ' ) then
  327. if (inraye.eq.0) then
  328. inraye = in
  329. NMAT = NMAT+1
  330. SEGADJ,imodel
  331. imodel.FORMOD(in) = 'THERMIQUE '
  332. DO i = NMAT, 2, -1
  333. imodel.MATMOD(i) = imodel.MATMOD(i-1)
  334. ENDDO
  335. imodel.MATMOD(1) = 'RAYONNEMENT '
  336. else
  337. write(ioimp,*) 'RAYONNEMENT lu > 1 !!!'
  338. endif
  339. endif
  340. enddo
  341. if (inconv.ne.0 .and. inraye.ne.0) then
  342. write(ioimp,*) 'CONVECTION & RAYONNEMENT lus > 1 !!!'
  343. call erreur(5)
  344. return
  345. endif
  346.  
  347. CALL PRQUOI(IMODEL)
  348.  
  349. c* Lecture de INFMOD :
  350. do in = 1, mn3lu
  351. jinf = jinf + 1
  352. imodel.INFMOD(in) = itabe4(jinf)
  353. enddo
  354. if (iimpil.eq.1972) then
  355. write(ioimp,*) ' MN3 & mn3lu',MN3,mn3lu
  356. write(ioimp,*) ' infmod',(infmod(in),in=1,mn3)
  357. endif
  358.  
  359. C* Cas standard :
  360. if (niveau.ge.13) then
  361. if (n45.gt.28) then
  362. imodel.CMATEE = itabe5(idecmo*(ISOUEL-1)+4)
  363. imodel.IMATEE = itabe1(ISOU+7)
  364. imodel.INATUU = itabe1(ISOU+8)
  365. c* do iou = 1, imodel.infele(/1)
  366. do in = 1, 16
  367. imodel.INFELE(in) = itabe9(in+(ISOUEL-1)*16)
  368. enddo
  369. c* do iou = 1, imodel.lnomid(/2)
  370. do iou = 1, 14
  371. nbrobl = itabe1(isou+7+2*iou)
  372. nbrfac = itabe1(isou+8+2*iou)
  373. if (nbrobl+nbrfac .ne. 0) then
  374. SEGINI,nomid
  375. do in = 1, nbrobl
  376. jnomid = jnomid+1
  377. nomid.lesobl(in) = itabe6(jnomid)
  378. enddo
  379. do in = 1, nbrfac
  380. jnomid = jnomid+1
  381. nomid.lesfac(in) = itabe6(jnomid)
  382. enddo
  383. SEGDES,nomid
  384. imodel.LNOMID(iou) = nomid
  385. endif
  386. enddo
  387.  
  388. C* Cas particuliers :
  389. else
  390. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina)
  391. if (ierr.ne.0) return
  392. imodel.CMATEE = cma
  393. imodel.IMATEE = ima
  394. imodel.INATUU = ina
  395. lmotva = 0
  396. lmotma = 0
  397. lmotmf = 0
  398. lmotpa = 0
  399. llmova = itabe1(ISOU+7)
  400. llmoma = itabe1(ISOU+8)
  401. llfama = itabe1(ISOU+9)
  402. c-dbg write(ioimp,*)'llmova llmoma llfama',llmova,llmoma,llfama
  403. jgn = LOCOMP
  404. if (llmova.ne.0) then
  405. jgm = llmova
  406. SEGINI,mlmots
  407. do in = 1, jgm
  408. jnomid=jnomid+1
  409. c-dbg write(ioimp,*) ' jnomid1' , jnomid
  410. mots(in) = itabe6(jnomid)
  411. enddo
  412. lmotva = mlmots
  413. endif
  414. if (llmoma.ne.0) then
  415. jgm = llmoma
  416. SEGINI,mlmots
  417. do in = 1, jgm
  418. jnomid = jnomid+1
  419. c-dbg write(ioimp,*) ' jnomid2 ' , jnomid
  420. mots(in) = itabe6(jnomid)
  421. enddo
  422. lmotma = mlmots
  423. endif
  424. if (llfama.ne.0) then
  425. jgm = llfama
  426. SEGINI,mlmots
  427. do in = 1, jgm
  428. jnomid = jnomid+1
  429. c-dbg write(ioimp,*) ' jnomid3 ' , jnomid
  430. mots(in)=itabe6(jnomid)
  431. enddo
  432. lmotmf = mlmots
  433. endif
  434. if (nparmo.ne.0) then
  435. jgm = nparmo
  436. SEGINI, mlmots
  437. do in = 1, nparmo
  438. jnomid=jnomid+1
  439. mots(in)=itabe6(jnomid)
  440. enddo
  441. lmotpa = mlmots
  442. endif
  443. c-dbg write(ioimp,*) 'Ici on a FORMOD(1)=',FORMOD(1),FORMOD(/2)
  444. c-dbg write(ioimp,*) ' cmate=',cmatee,imatee,inatuu
  445. CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa)
  446. endif
  447. C* Anciens niveaux < 13 :
  448. else
  449. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina)
  450. if (ierr.ne.0) return
  451. imodel.CMATEE = cma
  452. imodel.IMATEE = ima
  453. imodel.INATUU = ina
  454.  
  455. IF (FORMOD(1).eq.'MECANIQUE ' .or.
  456. & FORMOD(1).eq.'POREUX ' .or.
  457. & FORMOD(1).eq.'DIFFUSION ' .or.
  458. & FORMOD(1).eq.'ELECTROSTATIQUE ' .or.
  459. & FORMOD(/2).eq.2) then
  460. IF (MN3.lt.12) then
  461. MN3 = 12
  462. SEGADJ,imodel
  463. endif
  464. call prquoi(imodel)
  465. ENDIF
  466. lmotva = 0
  467. lmotma = 0
  468. lmotmf = 0
  469. lmotpa = 0
  470. CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa)
  471. endif
  472.  
  473. C* Cas particuliers :
  474. c-dbg write(ioimp,*) FORMOD(1),niveau,MN3
  475. IF (FORMOD(1).eq.'MAGNETODYNAMIQUE') THEN
  476. if (niveau.le.24 .and. MN3.lt.12) then
  477. MN3 = 12
  478. SEGADJ,imodel
  479. call prquoi(imodel)
  480. endif
  481. ENDIF
  482. IF (FORMOD(1).eq.'CHANGEMENT_PHASE' .or.
  483. & FORMOD(1).eq.'THERMOHYDRIQUE ') THEN
  484. if (niveau.le.25 .and. MN3.lt.12) then
  485. MN3 = 12
  486. SEGADJ,imodel
  487. call prquoi(imodel)
  488. endif
  489. ENDIF
  490.  
  491. if (niveau.ge.15) then
  492. c-dbg write(ioimp,*) ' nobmod jobj',nobmod,jobj
  493. do in = 1, nobmod
  494. jobj = jobj+1
  495. imodel.TYMODE(in) = itabe7(jobj)
  496. imodel.IVAMOD(in) = itabe8(jobj)
  497. enddo
  498. endif
  499.  
  500. *Petite modification en cas de modele externe :
  501. if (imodel.FORMOD(/2).eq.1) then
  502. if (imodel.FORMOD(1).eq.'MECANIQUE ' .or.
  503. & imodel.FORMOD(1).eq.'POREUX ') then
  504. if (imodel.INATUU.GE.0) goto 200
  505. iumat = 0
  506. ivisc = 0
  507. iviex = 0
  508. do in = 1, nmat
  509. if (matmod(in).eq.'NON_LINEAIRE ') iumat = in
  510. if (matmod(in).eq.'VISCO_EXTERNE ') ivisc = in
  511. enddo
  512. if (iumat.ne.0) then
  513. if (matmod(iumat+1).ne.'UTILISATEUR ') then
  514. write(ioimp,*) 'maj modele umat incorrect'
  515. call erreur(5)
  516. return
  517. endif
  518. imodel.INATUU = -1
  519. endif
  520. if (ivisc.ne.0) then
  521. if (imodel.INATUU.eq.-2) goto 200
  522. c* mise a jour du modele
  523. CALL MODVIX(momodl,nmod)
  524. CALL PLACE(momodl,nmod,iviex,matmod(ivisc+1))
  525. if (iviex.eq.0) then
  526. write(ioimp,*) 'MAJ modele IVIEX incorrect'
  527. call erreur(5)
  528. return
  529. endif
  530. imodel.INATUU = -2
  531. nobmod = nobmod + 1
  532. SEGADJ,imodel
  533. imodel.TYMODE(nobmod+1) = 'IVIEX '
  534. imodel.IVAMOD(nobmod+1) = iviex
  535. endif
  536. 200 continue
  537. endif
  538. endif
  539.  
  540. *Petite verification en diffusion
  541. if (FORMOD(1).eq.'DIFFUSION ') then
  542. if (niveau.lt.17) then
  543. write(ioimp,*) 'Incompatibilite de niveau !'
  544. call erreur(5)
  545. return
  546. endif
  547. *SG: Au-dessus du niveau 18, les noms d'inconnues lnomdd et lnomdu sont sauvegardes
  548. if (niveau.le.18) then
  549. call vermdi(tymode(1),tymode(2))
  550. if (ierr.ne.0) then
  551. write(ioimp,*) 'Revoir votre mise en donnees !'
  552. call erreur(5)
  553. return
  554. endif
  555. endif
  556. endif
  557.  
  558. SEGDES,IMODEL
  559.  
  560. 20 CONTINUE
  561.  
  562. SEGSUP,mtabe1,mtabe2,mtabe3
  563. SEGSUP,mtabe4,mtabe5
  564. if (nm6.gt.0) then
  565. SEGSUP,mtabe6,mtab6b
  566. endif
  567. if (nm7.gt.0) then
  568. SEGSUP,mtabe7,mtabe8
  569. endif
  570.  
  571. SEGDES,MMODEL
  572. ITLAC(**) = MMODEL
  573.  
  574. 10 CONTINUE
  575.  
  576. c RETURN
  577. END
  578.  
  579.  
  580.  
  581.  

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