Télécharger limodl.eso

Retour à la liste

Numérotation des lignes :

limodl
  1. C LIMODL SOURCE OF166741 24/12/18 21:15:21 12090
  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,1)
  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. c* Lecture de INFMOD :
  348. do in = 1, mn3lu
  349. jinf = jinf + 1
  350. imodel.INFMOD(in) = itabe4(jinf)
  351. enddo
  352. if (iimpil.eq.1972) then
  353. write(ioimp,*) ' MN3 & mn3lu',MN3,mn3lu
  354. write(ioimp,*) ' infmod',(infmod(in),in=1,mn3)
  355. endif
  356.  
  357. C* Cas standard :
  358. if (niveau.ge.13) then
  359. if (n45.gt.28) then
  360. imodel.CMATEE = itabe5(idecmo*(ISOUEL-1)+4)
  361. imodel.IMATEE = itabe1(ISOU+7)
  362. imodel.INATUU = itabe1(ISOU+8)
  363. c* do iou = 1, imodel.infele(/1)
  364. do in = 1, 16
  365. imodel.INFELE(in) = itabe9(in+(ISOUEL-1)*16)
  366. enddo
  367. c* do iou = 1, imodel.lnomid(/2)
  368. do iou = 1, 14
  369. nbrobl = itabe1(isou+7+2*iou)
  370. nbrfac = itabe1(isou+8+2*iou)
  371. if (nbrobl+nbrfac .ne. 0) then
  372. SEGINI,nomid
  373. do in = 1, nbrobl
  374. jnomid = jnomid+1
  375. nomid.lesobl(in) = itabe6(jnomid)
  376. enddo
  377. do in = 1, nbrfac
  378. jnomid = jnomid+1
  379. nomid.lesfac(in) = itabe6(jnomid)
  380. enddo
  381. SEGDES,nomid
  382. imodel.LNOMID(iou) = nomid
  383. endif
  384. enddo
  385.  
  386. C* Cas particuliers :
  387. else
  388. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina)
  389. if (ierr.ne.0) return
  390. imodel.CMATEE = cma
  391. imodel.IMATEE = ima
  392. imodel.INATUU = ina
  393. lmotva = 0
  394. lmotma = 0
  395. lmotmf = 0
  396. lmotpa = 0
  397. llmova = itabe1(ISOU+7)
  398. llmoma = itabe1(ISOU+8)
  399. llfama = itabe1(ISOU+9)
  400. c-dbg write(ioimp,*)'llmova llmoma llfama',llmova,llmoma,llfama
  401. jgn = LOCOMP
  402. if (llmova.ne.0) then
  403. jgm = llmova
  404. SEGINI,mlmots
  405. do in = 1, jgm
  406. jnomid=jnomid+1
  407. c-dbg write(ioimp,*) ' jnomid1' , jnomid
  408. mots(in) = itabe6(jnomid)
  409. enddo
  410. lmotva = mlmots
  411. endif
  412. if (llmoma.ne.0) then
  413. jgm = llmoma
  414. SEGINI,mlmots
  415. do in = 1, jgm
  416. jnomid = jnomid+1
  417. c-dbg write(ioimp,*) ' jnomid2 ' , jnomid
  418. mots(in) = itabe6(jnomid)
  419. enddo
  420. lmotma = mlmots
  421. endif
  422. if (llfama.ne.0) then
  423. jgm = llfama
  424. SEGINI,mlmots
  425. do in = 1, jgm
  426. jnomid = jnomid+1
  427. c-dbg write(ioimp,*) ' jnomid3 ' , jnomid
  428. mots(in)=itabe6(jnomid)
  429. enddo
  430. lmotmf = mlmots
  431. endif
  432. if (nparmo.ne.0) then
  433. jgm = nparmo
  434. SEGINI, mlmots
  435. do in = 1, nparmo
  436. jnomid=jnomid+1
  437. mots(in)=itabe6(jnomid)
  438. enddo
  439. lmotpa = mlmots
  440. endif
  441. c-dbg write(ioimp,*) 'Ici on a FORMOD(1)=',FORMOD(1),FORMOD(/2)
  442. c-dbg write(ioimp,*) ' cmate=',cmatee,imatee,inatuu
  443. CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa)
  444. endif
  445. C* Anciens niveaux < 13 :
  446. else
  447. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,cma,ima,ina)
  448. if (ierr.ne.0) return
  449. imodel.CMATEE = cma
  450. imodel.IMATEE = ima
  451. imodel.INATUU = ina
  452.  
  453. IF (FORMOD(1).eq.'MECANIQUE ' .or.
  454. & FORMOD(1).eq.'POREUX ' .or.
  455. & FORMOD(1).eq.'DIFFUSION ' .or.
  456. & FORMOD(1).eq.'ELECTROSTATIQUE ' .or.
  457. & FORMOD(/2).eq.2) then
  458. IF (MN3.lt.12) then
  459. MN3 = 12
  460. SEGADJ,imodel
  461. endif
  462. call prquoi(imodel)
  463. ENDIF
  464. lmotva = 0
  465. lmotma = 0
  466. lmotmf = 0
  467. lmotpa = 0
  468. CALL INOMID(imodel,lmotva,lmotma,lmotmf,lmotpa)
  469. endif
  470.  
  471. C* Cas particuliers :
  472. c-dbg write(ioimp,*) FORMOD(1),niveau,MN3
  473. IF (FORMOD(1).eq.'MAGNETODYNAMIQUE') THEN
  474. if (niveau.le.24 .and. MN3.lt.12) then
  475. MN3 = 12
  476. SEGADJ,imodel
  477. call prquoi(imodel)
  478. endif
  479. ENDIF
  480. IF (FORMOD(1).eq.'CHANGEMENT_PHASE' .or.
  481. & FORMOD(1).eq.'THERMOHYDRIQUE ') THEN
  482. if (niveau.le.25 .and. MN3.lt.12) then
  483. MN3 = 12
  484. SEGADJ,imodel
  485. call prquoi(imodel)
  486. endif
  487. ENDIF
  488.  
  489. if (niveau.ge.15) then
  490. c-dbg write(ioimp,*) ' nobmod jobj',nobmod,jobj
  491. do in = 1, nobmod
  492. jobj = jobj+1
  493. imodel.TYMODE(in) = itabe7(jobj)
  494. imodel.IVAMOD(in) = itabe8(jobj)
  495. enddo
  496. endif
  497.  
  498. *Petite modification en cas de modele externe :
  499. if (imodel.FORMOD(/2).eq.1) then
  500. if (imodel.FORMOD(1).eq.'MECANIQUE ' .or.
  501. & imodel.FORMOD(1).eq.'POREUX ') then
  502. if (imodel.INATUU.GE.0) goto 200
  503. iumat = 0
  504. ivisc = 0
  505. iviex = 0
  506. do in = 1, nmat
  507. if (matmod(in).eq.'NON_LINEAIRE ') iumat = in
  508. if (matmod(in).eq.'VISCO_EXTERNE ') ivisc = in
  509. enddo
  510. if (iumat.ne.0) then
  511. if (matmod(iumat+1).ne.'UTILISATEUR ') then
  512. write(ioimp,*) 'maj modele umat incorrect'
  513. call erreur(5)
  514. return
  515. endif
  516. imodel.INATUU = -1
  517. endif
  518. if (ivisc.ne.0) then
  519. if (imodel.INATUU.eq.-2) goto 200
  520. c* mise a jour du modele
  521. CALL MODVIX(momodl,nmod)
  522. CALL PLACE(momodl,nmod,iviex,matmod(ivisc+1))
  523. if (iviex.eq.0) then
  524. write(ioimp,*) 'MAJ modele IVIEX incorrect'
  525. call erreur(5)
  526. return
  527. endif
  528. imodel.INATUU = -2
  529. nobmod = nobmod + 1
  530. SEGADJ,imodel
  531. imodel.TYMODE(nobmod+1) = 'IVIEX '
  532. imodel.IVAMOD(nobmod+1) = iviex
  533. endif
  534. 200 continue
  535. endif
  536. endif
  537.  
  538. *Petite verification en diffusion
  539. if (FORMOD(1).eq.'DIFFUSION ') then
  540. if (niveau.lt.17) then
  541. write(ioimp,*) 'Incompatibilite de niveau !'
  542. call erreur(5)
  543. return
  544. endif
  545. *SG: Au-dessus du niveau 18, les noms d'inconnues lnomdd et lnomdu sont sauvegardes
  546. if (niveau.le.18) then
  547. call vermdi(tymode(1),tymode(2))
  548. if (ierr.ne.0) then
  549. write(ioimp,*) 'Revoir votre mise en donnees !'
  550. call erreur(5)
  551. return
  552. endif
  553. endif
  554. endif
  555.  
  556. SEGDES,IMODEL
  557.  
  558. 20 CONTINUE
  559.  
  560. SEGSUP,mtabe1,mtabe2,mtabe3
  561. SEGSUP,mtabe4,mtabe5
  562. if (nm6.gt.0) then
  563. SEGSUP,mtabe6,mtab6b
  564. endif
  565. if (nm7.gt.0) then
  566. SEGSUP,mtabe7,mtabe8
  567. endif
  568.  
  569. SEGDES,MMODEL
  570. ITLAC(**) = MMODEL
  571.  
  572. 10 CONTINUE
  573.  
  574. c RETURN
  575. END
  576.  
  577.  
  578.  

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