Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

  1. C MODELI SOURCE CB215821 20/06/06 21:15:09 10620
  2. C----------------------------------------------------------------------C
  3. C OPERATEUR MODELE C
  4. C C
  5. C Creation d'un objet MODELE C
  6. C C
  7. C Syntaxe : MOD1 = MODL GEO1 TYPE_CAL TYPE_MAT ( TYPE_ELE ) ; C
  8. C C
  9. C GEO1 MAILLAGE de base C
  10. C TYPE_CAL MOT(S) pour definir la FORMULATION C
  11. C TYPE_MAT MOT(S) pour definir le MATERIAU C
  12. C TYPE_ELE MOT(S) pour definir les ELEMENTS FINIS a utiliser C
  13. C MOD1 Resultat de type MODELE C
  14. C----------------------------------------------------------------------C
  15. C PPU : Modif pour les materiaux unidirectionels en plasticite
  16.  
  17. SUBROUTINE MODELI
  18.  
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCHAMP
  26. -INC CCGEOME
  27.  
  28. -INC SMELEME
  29. -INC SMMODEL
  30. POINTEUR IMODE3.IMODEL,IMODE4.IMODEL,IMODE5.IMODEL
  31. -INC SMTABLE
  32. -INC SMLMOTS
  33. -INC SMCOORD
  34.  
  35. POINTEUR NOMID1.NOMID
  36. SEGMENT ilmora
  37. integer LIMORA(100)
  38. endsegment
  39. SEGMENT LIMODE(0)
  40. SEGMENT PLICON
  41. integer mlicon(NLCON),tlicon(NLCON)
  42. ENDSEGMENT
  43.  
  44. EXTERNAL LONG
  45. PARAMETER (NBFORM=18,NBCON=10,NBEXT=7,NBDIF=1)
  46. PARAMETER (N1MAX=300,N2MAX=200)
  47. PARAMETER (NLOMAX=5)
  48.  
  49. DIMENSION LESMOD(N1MAX)
  50. CHARACTER*4 deriv(1)
  51. CHARACTER*4 MOTEF(N2MAX),LESTEF(N2MAX),MOCON(NBCON),MOEXT(NBEXT),
  52. & MOINCO(NBDIF)
  53. CHARACTER*4 MNLOCA(NLOMAX),MNLVAR(1)
  54. CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,CMATE,PHAM
  55. CHARACTER*8 PAR1,MDIINC,MDIDUA
  56. CHARACTER*(LCONMO) CONM
  57. CHARACTER*16 MOFORM(NBFORM),LESFOR(2),MOPROP(N1MAX),LESPRO(N1MAX)
  58. CHARACTER*16 mderiv(6),LMENOM,LDINOM,OPTEMP(3)
  59. CHARACTER*(LOCHAI) MOTEMP,LMELIB,LDILIB,LMEFCT,LDIFCT
  60. LOGICAL LOGRE,LOGIN,LMEEXT,LMENLX,LMEVIX,LOSTAT,LOMELA,LINOMID
  61. LOGICAL LDIEXT,LDISOR,LOBBAR
  62.  
  63. CHARACTER*4 CHPRIM,CHDUAL
  64.  
  65. C CHARACTER*4 MODEPL(11)
  66. CHARACTER*4 mgauss(4)
  67. C DATA MODEPL / 'UX ','UY ','UZ ','UR ','UZ ','UT ',
  68. C & 'P ','PI ','T ','TH ','VEL ' /
  69. DATA MGAUSS /'EPAI' , 'RIGI' , 'MASS' ,'CONT'/
  70. DATA DERIV /'EPSI'/
  71. DATA MDERIV/'LINEAIRE ','QUADRATIQUE ',
  72. $ 'TRUESDELL ','JAUMANN ',
  73. $ 'UTILISATEUR ','FEFP '/
  74. DATA OPTEMP/'PHASE ','ADVECTION ',
  75. $ 'CONDUCTION '/
  76. C----------------------------------------------------------------------C
  77. C DEFINITION DES NOMS DE FORMULATIONS C
  78. C Formulation LIAISON : pour operateurs DYNE et COMP C
  79. C----------------------------------------------------------------------C
  80. DATA MOFORM /
  81. & 'THERMIQUE ','MECANIQUE ','LIQUIDE ',
  82. & 'POREUX ','DARCY ','CONTACT ',
  83. & 'MAGNETODYNAMIQUE','NAVIER_STOKES ','MELANGE ',
  84. & 'EULER ','FISSURE ','LIAISON ',
  85. & 'THERMOHYDRIQUE ','ELECTROSTATIQUE ','DIFFUSION ',
  86. & 'CHARGEMENT ','METALLURGIE ','CHANGEMENT_PHASE'/
  87.  
  88. C (fdp) Ajout d'un nouveau mot clef 'LIBRE' ou 'LIE' pour les JOI1
  89. DATA MOCON / 'CONS','INTE','DPGE','PHAS','STAT','LCOI','LCOS',
  90. & 'LIBR','LIE ','NON_'/
  91. DATA MOEXT / 'NUME','NOM_','PARA','C_MA','C_VA','LIB_','FCT_' /
  92. DATA MOINCO / 'INCO' /
  93. DATA MNLVAR/ 'V_MO' /
  94.  
  95. CONM =' '
  96. PHAM =' '
  97. MDIINC=' '
  98. MDIDUA=' '
  99.  
  100. NPINT = 0
  101. MN3 = 0
  102. MFR = 0
  103. C MFRTMP = 0
  104. lucvar = 0
  105. lucmat = 0
  106. lucmaf = 0
  107. luparx = 0
  108. lobbar = .false.
  109.  
  110. C Lecture d'un MAILLAGE ou d'une TABLE de sous-type DOMAINE
  111. IPTABL = 0
  112. IPGEOM = 0
  113. IPGEO2 = 0
  114. IReMOD = 0
  115. CALL LIRTAB('DOMAINE',IPTABL,0,IRET)
  116. IF (IERR.NE.0) RETURN
  117.  
  118. IF (IRET.EQ.0) THEN
  119. CALL LIROBJ('MAILLAGE',IPGEOM,1,IRET)
  120. IF (IERR.NE.0) RETURN
  121. C Verification de l'unicite des elements
  122. IPT1=IPGEOM
  123. CALL UNIQMA(IPT1,NBDI1)
  124. IF(NBDI1 .NE. 0)THEN
  125. MOTERR(1:8)='MAILLAGE'
  126. CALL ERREUR(1019)
  127. RETURN
  128. ENDIF
  129.  
  130. ELSE
  131. IVALIN=0
  132. XVALIN=REAL(0.D0)
  133. LOGIN=.TRUE.
  134. IOBIN=0
  135. TAPIND='MOT '
  136. CHARIN='MAILLAGE'
  137. TYPOBJ='MAILLAGE'
  138. CALL ACCTAB(IPTABL,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  139. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  140. IF (IERR.NE.0) RETURN
  141. IPGEOM=IOBRE
  142. ENDIF
  143. C
  144. C Lecture d'une FORMULATION
  145. ICOND=1
  146. NFOR =0
  147. NMAT =0
  148. CALL MESLIR(-182)
  149.  
  150. 51 IF (NFOR.NE.0) CALL MESLIR(-181)
  151. CALL LIRMOT(MOFORM,NBFORM,IPFORM,ICOND)
  152. IF (IERR .NE. 0) RETURN
  153.  
  154. IF (IPFORM .EQ. 0) GOTO 52
  155. NFOR=NFOR+1
  156. IF (NFOR.GT.2) THEN
  157. CALL ERREUR(251)
  158. RETURN
  159. ENDIF
  160. ICOND=0
  161. LESFOR(NFOR)=MOFORM(IPFORM)
  162. GOTO 51
  163.  
  164. C Cas d'une FORMULATION simple (NFOR=1)
  165. 52 IF (NFOR.EQ.1) THEN
  166. jderiv=mepsil
  167. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  168. CALL MODEL1(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  169. ELSE IF(LESFOR(1).EQ.'MECANIQUE') THEN
  170. CALL MODEL2(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  171. ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN
  172. CALL MODEL3(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  173. ELSE IF(LESFOR(1).EQ.'POREUX') THEN
  174. CALL MODEL6(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  175. ELSE IF(LESFOR(1).EQ.'DARCY') THEN
  176. CALL MODEL7(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  177. ELSE IF(LESFOR(1).EQ.'CONTACT') THEN
  178. CALL MODEL8(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  179. ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  180. CALL MODE10(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  181. ELSE IF(LESFOR(1).EQ.'NAVIER_STOKES') THEN
  182. CALL MODE11(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  183. ELSE IF (LESFOR(1).EQ.'MELANGE') THEN
  184. CALL MODE12(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  185. DO i=1,N1MAX
  186. LESMOD(i)=0
  187. ENDDO
  188. ELSE IF(LESFOR(1).EQ.'EULER') THEN
  189. CALL MODE13(MOPROP,NPROP,NBTEF,N1MAX)
  190. ELSE IF(LESFOR(1).EQ.'FISSURE') THEN
  191. CALL MODE14(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  192. ELSE IF(LESFOR(1).EQ.'LIAISON') THEN
  193. CALL MODE15(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  194. ELSE IF(LESFOR(1).EQ.'THERMOHYDRIQUE') THEN
  195. CALL MODE16(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  196. ELSE IF(LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN
  197. CALL MODE17(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  198. ELSE IF(LESFOR(1).EQ.'DIFFUSION ') THEN
  199. CALL MODE18(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  200. ELSE IF(LESFOR(1).EQ.'CHARGEMENT ') THEN
  201. CALL MODE19(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  202. ELSE IF(LESFOR(1).EQ.'METALLURGIE ') THEN
  203. CALL MODE21(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  204. ELSE IF(LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
  205. CALL MODE22(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  206. ELSE
  207. CALL ERREUR (251)
  208. ENDIF
  209. IF(IERR.NE.0) RETURN
  210.  
  211. ELSE
  212. C Cas d'une FORMULATION couplee (NFOR=2)
  213. jderiv=mepsil
  214. IF ((LESFOR(1).EQ.'LIQUIDE'.AND.LESFOR(2).EQ.'MECANIQUE').OR.
  215. . (LESFOR(2).EQ.'LIQUIDE'.AND.LESFOR(1).EQ.'MECANIQUE')) THEN
  216. CALL MODEL5(NPROP,MOTEF,NBTEF,N2MAX)
  217. IF(IERR.NE.0) RETURN
  218. ELSE
  219. CALL ERREUR(251)
  220. RETURN
  221. ENDIF
  222. ENDIF
  223.  
  224. C Lecture eventuelle des proprietes du MODELE de MATERIAU
  225. CALL MESLIR(-180)
  226. ifrtt = 0
  227. IFROCA = 0
  228. ifacaf = 0
  229. isyme = 0
  230. nbga = 10
  231. nbdang = 3
  232. icavit = 0
  233. kjh = 0
  234. isrce = 0
  235. iraye = 0
  236. ICONV = 0
  237. NMAT = 0
  238. iprop = 0
  239. ipgeo2 = 0
  240. IF (NPROP.EQ.0) GOTO 43
  241. 41 IF (NMAT .NE.0) CALL MESLIR(-179)
  242. CALL LIRMOT(MOPROP,NPROP,LAPROP,0)
  243. C* if( laprop.ne.0) write(6,*) ' lecture de ', moprop(laprop)
  244. IF (IERR.NE.0) RETURN
  245.  
  246. C ---------- Cas d'un MODELE de CONTACT
  247. IF(LESFOR(1).EQ.'CONTACT') then
  248. if(laprop.eq.3) then
  249. call ecrobj('MAILLAGE',IPGEOM)
  250. call impf
  251. call lirobj('MAILLAGE',ipgeo2,1,iretou)
  252. if(ierr.ne.0) return
  253. endif
  254. if(laprop.eq.5) then
  255. ifrtt=0
  256. ifroca=1
  257. C call lirobj('MMODEL',IFROCA,1,iOK)
  258. C IF(ierr.NE.0) return
  259. Call lirobj('MAILLAGE',IBETON,1,IOK)
  260. IF(ierr.NE.0) return
  261. endif
  262. if(laprop.eq.4) then
  263. ifrtt=1
  264. endif
  265. ENDIF
  266.  
  267. C ---------- Cas d'un MODELE de METALLURGIE
  268. C modele cree par T.L. en mai 2018
  269. IF (lesfor(1).eq.'METALLURGIE' .AND. NMAT.le.4 ) THEN
  270. NMAT=NMAT+1
  271. IF( laprop .eq. 1 ) THEN
  272. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(1)='PHASES'
  273. CALL LIROBJ('LISTMOTS', lucvar, 1, IRETOU)
  274. MLMOTS = lucvar
  275. segact MLMOTS
  276. NB_PHA = MLMOTS.MOTS(/2)
  277. C On remplira ensuite MATMOD() avec lespro()
  278. lespro(laprop) = MOPROP(laprop)
  279.  
  280. ELSEIF( laprop .eq. 2 ) THEN
  281. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(2)='REACTIFS'
  282. CALL LIROBJ('LISTMOTS', ireact, 1, IRETOU)
  283. MLMOT1 = ireact
  284. segact MLMOT1
  285. NB_REA = MLMOT1.MOTS(/2)
  286. C On remplira ensuite MATMOD() avec lespro()
  287. lespro(laprop) = MOPROP(laprop)
  288.  
  289. ELSEIF( laprop .eq. 3 ) THEN
  290. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(3)='PRODUITS'
  291. CALL LIROBJ('LISTMOTS', iprodu, 1, IRETOU)
  292. MLMOT2 = iprodu
  293. segact MLMOT2
  294. NB_PRO = MLMOT2.MOTS(/2)
  295. C On remplira ensuite MATMOD() avec lespro()
  296. lespro(laprop) = MOPROP(laprop)
  297.  
  298. ELSEIF( laprop .eq. 4 ) THEN
  299. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(4)='TYPE'
  300. CALL LIROBJ('LISTMOTS', lucmat, 1, IRETOU)
  301. MLMOT3 = lucmat
  302. segact MLMOT3
  303. NB_TYP = MLMOT3.MOTS(/2)
  304. C On remplira ensuite MATMOD() avec lespro()
  305. lespro(laprop) = MOPROP(laprop)
  306.  
  307. ELSE
  308. CALL ERREUR(5)
  309. RETURN
  310. ENDIF
  311.  
  312. C Les pointeurs lucvar et lucmat sont ensuite
  313. C passees a inomid pour remplir les NOMID de l'objet MMODEL
  314. C Les pointeurs lucvar, ireact, iprodu, lucmat seront mis
  315. C dans le tableau IVAMOD de l'objet IMODEL
  316.  
  317. IF(NMAT .lt. 4) THEN
  318. C On n'a pas encore recuperer toutes les donnees
  319. go to 41
  320.  
  321. ELSE IF(NMAT .eq. 4) THEN
  322.  
  323. C On emet une erreur si les MLMOTS 'REACTIFS', 'PRODUITS' et
  324. C 'TYPES' n'ont pas ete luts
  325. if(ireact .le. 0 .OR. iprodu .le. 0 .OR. lucmat .le. 0) then
  326. CALL ERREUR(21)
  327. RETURN
  328. endif
  329.  
  330. C Autant de produits que de reactifs
  331. if( NB_PRO .ne. NB_REA ) then
  332. CALL ERREUR(1078)
  333. RETURN
  334. endif
  335.  
  336. C On initialise le MLMOTS des PHASES si celui ci n'a pas ete lut
  337. icompt = 0
  338. if( lucvar .le. 0) then
  339. icompt = 1
  340. NB_PHA = NB_REA + NB_PRO
  341. JGM = NB_PHA
  342. JGN = 4
  343. SEGINI, MLMOTS
  344. lucvar = MLMOTS
  345. C On remplira ensuite MATMOD() avec lespro()
  346. lespro(1) = MOPROP(1)
  347. endif
  348.  
  349. C On a recuperer toutes les donnees, on effectue quelques tests
  350. do ipha = 1, NB_PRO
  351.  
  352. C Produits differents du reactif pour chaque reaction
  353. if( MLMOT1.MOTS(ipha) .eq. MLMOT2.MOTS(ipha) ) then
  354. MOTERR(1:4)=MLMOT1.MOTS(ipha)
  355. MOTERR(5:8)=MLMOT2.MOTS(ipha)
  356. CALL ERREUR(1075)
  357. RETURN
  358. endif
  359.  
  360. irphas = 0
  361. ipphas = 0
  362. CALL PLACE(MLMOTS.MOTS, NB_PHA, irphas, MLMOT1.MOTS(ipha))
  363. CALL PLACE(MLMOTS.MOTS, NB_PHA, ipphas, MLMOT2.MOTS(ipha))
  364. C Si le nom du produit ou du reactif n'a pas ete lut dans le
  365. C MLMOTS des PHASES :
  366. C On le rajoute si lucvar n'avait pas ete lut
  367. C On emet une erreur sinon
  368. if(irphas .eq. 0) then
  369. if( icompt .ge. 1 ) then
  370. MLMOTS.MOTS(icompt) = MLMOT1.MOTS(ipha)
  371. icompt = icompt + 1
  372. else
  373. MOTERR(1:4)=MLMOT1.MOTS(ipha)
  374. CALL ERREUR(1080)
  375. RETURN
  376. endif
  377. endif
  378. if(ipphas .eq. 0) then
  379. if( icompt .ge. 1 ) then
  380. MLMOTS.MOTS(icompt) = MLMOT2.MOTS(ipha)
  381. icompt = icompt + 1
  382. else
  383. MOTERR(1:4)=MLMOT2.MOTS(ipha)
  384. CALL ERREUR(1080)
  385. RETURN
  386. endif
  387. endif
  388.  
  389. enddo
  390. C On corrige la taille de MLMOTS :
  391. if( icompt .ge. 1 ) then
  392. JGM = icompt - 1
  393. JGN = 4
  394. SEGADJ, MLMOTS
  395. endif
  396.  
  397. C Un type de reaction definit pour chaque reaction
  398. if( NB_TYP .ne. NB_PRO ) then
  399. CALL ERREUR(1077)
  400. RETURN
  401. endif
  402.  
  403. LAPROP = 0
  404.  
  405. segact,MLMOTS*NOMOD, MLMOT1*NOMOD, MLMOT2*NOMOD, MLMOT3*NOMOD
  406. ENDIF
  407. ENDIF
  408.  
  409. C ---------- Cas d'un MODELE de THERMIQUE CONVECTION ou RAYONNEMENT
  410. IF (lesfor(1).eq.'THERMIQUE' .AND. kjh.eq.0) then
  411. IF (moprop(laprop).eq.'CONVECTION') then
  412. ICONV=1
  413. nmat=nmat+1
  414. kjh=1
  415. lespro(nmat)=moprop(laprop)
  416. call model4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  417. go to 41
  418. ELSE IF (moprop(laprop).eq.'RAYONNEMENT') then
  419. iraye=1
  420. kjh=1
  421. nmat=nmat+1
  422. lespro(nmat)=moprop(laprop)
  423. segini ilmora
  424. call model9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  425. go to 41
  426. ELSE IF (moprop(laprop).eq.'SOURCE') then
  427. isrce=1
  428. kjh=1
  429. nmat=nmat+1
  430. lespro(nmat)=moprop(laprop)
  431. call mode23(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  432. go to 41
  433. ENDIF
  434. ENDIF
  435.  
  436. C ---------- Cas d'un MODELE de RAYONNEMENT
  437. IF (iraye.eq.1) then
  438. if(laprop.eq.1) icavit=1
  439. if(laprop.eq.9) then
  440. call lirent( nbdang,1,iretou)
  441. if(ierr.ne.0) return
  442. endif
  443. if(laprop.eq.8) then
  444. call lirent( nbga,1,iretou)
  445. if(ierr.ne.0) return
  446. endif
  447. if(laprop.eq.7)then
  448. isyme=1
  449. call lirobj('POINT',ipp1,1,iretou)
  450. call lirobj('POINT',ipp2,1,iretou)
  451. if(idim.eq.3)call lirobj('POINT',ipp3,1,iretou)
  452. if(ierr.ne.0) return
  453. endif
  454. if(laprop.eq.2) then
  455. ifacaf=1
  456. call lirobj('MAILLAGE',ipfac1,1,iretou)
  457. call lirobj('MAILLAGE',ipfac2,1,iretou)
  458. call lirobj('MAILLAGE',ipfac3,1,iretou)
  459. call lirobj('MMODEL' ,imoco ,1,iretou)
  460. if(ierr.ne.0) return
  461. endif
  462. ENDIF
  463.  
  464. C ---------- MODELE de SOURCE
  465. IF (isrce.eq.1) then
  466. C Par DEFAUT, formulation generale (initialement "UNIFORME")
  467. C IF (laprop.eq.0) THEN
  468. C nmat=nmat+1
  469. C lespro(nmat)=moprop(1)
  470. C ENDIF
  471. isrce=isrce+1
  472. ELSEIF (isrce.eq.2) THEN
  473. IF (lespro(nmat).EQ.'GAUSSIENNE') THEN
  474. IF (IDIM.EQ.1) THEN
  475. INTERR(1) = IDIM
  476. CALL ERREUR(1104)
  477. RETURN
  478. ENDIF
  479. C Source Gaussienne : par DEFAUT, ISOTROPE
  480. IF (laprop.eq.0) THEN
  481. nmat=nmat+1
  482. lespro(nmat)=moprop(2)
  483. ENDIF
  484. ENDIF
  485. isrce=isrce+1
  486. ENDIF
  487.  
  488. C ---------- Cas d'un MODELE de MELANGE
  489. IF (LESFOR(1).EQ.'MELANGE') THEN
  490. CALL LIROBJ('MMODEL',IPMOD,0,iOK)
  491. IF (IERR.NE.0) RETURN
  492. C ----- le melange par defaut est 'PARALLELE'
  493. IF (iOK.NE.0) THEN
  494. IF (LAPROP.EQ.0) LAPROP=3
  495. LESMOD(NMAT+1)=IPMOD
  496. ENDIF
  497. ENDIF
  498. C
  499. IF (LAPROP .EQ. 0) GOTO 42
  500. NMAT=NMAT+1
  501. LESPRO(NMAT)=MOPROP(LAPROP)
  502. GOTO 41
  503.  
  504. 42 CONTINUE
  505.  
  506. IF (NMAT .NE. 0) THEN
  507. C on teste tout de suite l'existence de la donnee de la derivee
  508. C il ne faut pas de modele de materiau commencant par deri
  509. nmit=nmat
  510. do i=1,nmit
  511. if( lespro(i)(1:4).eq.'EPSI') then
  512. call erreur(19)
  513. return
  514. endif
  515. enddo
  516.  
  517. C on cherche le mot 'EPSI'
  518. CALL LIRMOT(deriv,1,itrou,0)
  519. IF(itrou.ne.0) then
  520. call lirmot(mderiv,5,iret,1)
  521. if(ierr.ne.0) return
  522. Jderiv=iret
  523. ENDIF
  524.  
  525. IF (LESFOR(1).EQ.'THERMIQUE'.AND.ISRCE.EQ.0) THEN
  526. C +---------------------------------------------------------+
  527. C | FORMULATION THERMIQUE : 'ISOTROPE' |
  528. C +---------------------------------------------------------+
  529. IPROP = 3
  530. IF (IDIM.EQ.1) IPROP = 1
  531. CALL PLACE(MOPROP,IPROP,IPLAC,LESPRO(1))
  532. IF (IPLAC.EQ.0) THEN
  533. DO i=NMAT,1,-1
  534. LESPRO(i+1)=LESPRO(i)
  535. ENDDO
  536. LESPRO(1)='ISOTROPE'
  537. NMAT=NMAT+1
  538. ELSEif(NMAT.EQ.1)THEN
  539. NMAT=NMAT+1
  540. LESPRO(2)='CONDUCTION'
  541. ENDIF
  542.  
  543. C Ajout du mot 'CONDUCTION' si besoin avec phase et advection
  544. idoico=0
  545. idejco=0
  546. DO i=1,nmat
  547. CALL PLACE (OPTEMP,3,iplac,LESPRO(i))
  548. if(iplac.eq.1.or.iplac.eq.2) idoico=1
  549. if(iplac.eq.3) idejco=1
  550. enddo
  551.  
  552. if( idoico.ne.0.and.idejco.eq.0) then
  553. nmat=nmat+1
  554. lespro(nmat)='CONDUCTION'
  555. endif
  556.  
  557. ELSEIF (LESFOR(1).EQ.'MECANIQUE'.OR. LESFOR(1).EQ.'POREUX') THEN
  558. C +----------------------------------------------------------+
  559. C | FORMULATION MECANIQUE / POREUX : 'ELASTIQUE' 'ISOTROPE' |
  560. C +----------------------------------------------------------+
  561. IF (NMAT.GE.2)THEN
  562. CALL MODELA(MOPROP,NMOD)
  563. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(2))
  564. IF (IPLAC.EQ.0) THEN
  565. DO i=NMAT,2,-1
  566. LESPRO(i+1)=LESPRO(i)
  567. ENDDO
  568. LESPRO(2)='ISOTROPE'
  569. NMAT=NMAT+1
  570. ENDIF
  571. ELSE IF (NMAT.EQ.1) THEN
  572. LESPRO(2)='ISOTROPE'
  573. NMAT=2
  574. ENDIF
  575. C MECANIQUE / POREUX : modele par defaut en comportement non lineaire
  576. CALL MODNLI(MOPROP,NMOD)
  577. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
  578. C Par defaut : PLASTIQUE ISOTROPE
  579. IF (IPLAC.EQ.1) THEN
  580. NMAT=NMAT+1
  581. LESPRO(NMAT)='ISOTROPE'
  582. C Par defaut : FLUAGE NORTON
  583. ELSE IF (IPLAC.EQ.2) THEN
  584. NMAT=NMAT+1
  585. LESPRO(NMAT)='NORTON'
  586. C Par defaut : VISCOPLASTIQUE ONERA
  587. ELSE IF (IPLAC.EQ.3) THEN
  588. NMAT=NMAT+1
  589. LESPRO(NMAT)='ONERA'
  590. C Par defaut : ENDOMMAGEMENT MAZARS
  591. ELSE IF (IPLAC.EQ.4) THEN
  592. NMAT=NMAT+1
  593. LESPRO(NMAT)='MAZARS'
  594. C Par defaut : ENDOMMAGEMENT PLASTIQUE P/Y
  595. ELSE IF (IPLAC.EQ.5) THEN
  596. NMAT=NMAT+1
  597. LESPRO(NMAT)='PSURY'
  598. ELSE IF (IPLAC.EQ.6) THEN
  599. C Si 'MECANIQUE' OU 'POREUX' : pas de comportement par defaut
  600. C pour 'NON_LINEAIRE'
  601. CALL ERREUR(945)
  602. RETURN
  603. ELSE IF (IPLAC.EQ.7) THEN
  604. C Si 'MECANIQUE' : pas de comportement par defaut pour 'VISCO_EXTERNE'
  605. IF (LESFOR(1).EQ.'MECANIQUE') THEN
  606. CALL ERREUR(946)
  607. C Si 'POREUX' : option non implementee
  608. ELSE IF (LESFOR(1).EQ.'POREUX') THEN
  609. CALL ERREUR(251)
  610. ENDIF
  611. RETURN
  612. ENDIF
  613.  
  614. ELSEIF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  615. C +---------------------------------------------------------------+
  616. C | FORMULATION MAGNETODYNAMIQUE : 'POTENTIEL_VECTEUR' 'ISOTROPE' |
  617. C +---------------------------------------------------------------+
  618. IF (NMAT.EQ.1) THEN
  619. IF (LESPRO(1).NE.'POTENTIEL_VECTEU') THEN
  620. LESPRO(2)=LESPRO(1)
  621. LESPRO(1)='POTENTIEL_VECTEU'
  622. ELSE
  623. LESPRO(2)='ISOTROPE'
  624. ENDIF
  625. NMAT=2
  626. ENDIF
  627.  
  628. ELSEIF (LESFOR(1).EQ.'MELANGE') THEN
  629. C +-------------------------------+
  630. C | FORMULATION MELANGE : 'CEREM' |
  631. C +-------------------------------+
  632. NMAT1=NMAT
  633. IF (NMAT.EQ.0) THEN
  634. LESPRO(1)='CEREM'
  635. NMAT=1
  636. ENDIF
  637.  
  638. ELSEIF (LESFOR(1).EQ.'LIAISON') THEN
  639. C +-------------------------------------------------+
  640. C | FORMULATION LIAISON : pas d''option par defaut |
  641. C +-------------------------------------------------+
  642.  
  643. ELSEIF (LESFOR(1).EQ.'ELECTROSTATIQUE' ) THEN
  644. C +-------------------------------------------+
  645. C | FORMULATION ELECTROSTATIQUE : 'ISOTROPE' |
  646. C +-------------------------------------------+
  647. IPROP = 3
  648. IF (IDIM.EQ.1) IPROP = 1
  649. CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1))
  650. IF (IPLAC.EQ.0) THEN
  651. DO i=NMAT,1,-1
  652. LESPRO(i+1)=LESPRO(i)
  653. ENDDO
  654. LESPRO(1)='ISOTROPE'
  655. NMAT=NMAT+1
  656. ENDIF
  657.  
  658. ELSEIF (LESFOR(1).EQ.'DIFFUSION' ) THEN
  659. C +-------------------------------------------+
  660. C | FORMULATION DIFFUSION : 'ISOTROPE' 'FICK' |
  661. C +-------------------------------------------+
  662. IPROP = 3
  663. IF (IDIM.EQ.1) IPROP = 1
  664. CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1))
  665. IF (IPLAC.EQ.0) THEN
  666. DO i=NMAT,1,-1
  667. LESPRO(i+1)=LESPRO(i)
  668. ENDDO
  669. LESPRO(1)='ISOTROPE'
  670. NMAT=NMAT+1
  671. ENDIF
  672. CALL MODDIF(MOPROP,NMOD)
  673. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
  674. IF (IPLAC.EQ.0) THEN
  675. NMAT=NMAT+1
  676. LESPRO(NMAT)='FICK'
  677. ENDIF
  678.  
  679. ELSEIF(LESFOR(1).EQ.'CONTACT' ) THEN
  680. C +----------------------------------+
  681. C | FORMULATION CONTACT : UNILATERAL |
  682. C +----------------------------------+
  683. call place ( moprop,2,iplac,lespro(1))
  684. if( iplac.eq.0) then
  685. do iur=1,nmat
  686. lespro(nmat+2-iur)=lespro (nmat +1-iur)
  687. enddo
  688. lespro(1)='UNILATERAL'
  689. nmat=nmat+1
  690. endif
  691. ENDIF
  692.  
  693. ELSE
  694. C si NMAT=0 on met le premier mot autorisé
  695. NMAT=1
  696. LESPRO(1)=MOPROP(1)
  697.  
  698. IF (LESFOR(1).EQ.'CHARGEMENT') THEN
  699. C +------------------------------------------------------------------+
  700. C | Defaut pour une FORMULATION CHARGEMENT : PAS DE CHOIX PAR DEFAUT |
  701. C +------------------------------------------------------------------+
  702. C L'UTILISATEUR DOIT SPECIFIER D'AUTRES MOT CLES APRES 'CHARGEMENT'
  703. CALL ERREUR(251)
  704. RETURN
  705.  
  706. ELSEIF(LESFOR(1).EQ.'THERMIQUE') THEN
  707. C +----------------------------------------------------+
  708. C | Defaut pour une FORMULATION THERMIQUE : CONDUCTION |
  709. C +----------------------------------------------------+
  710. NMAT = NMAT+1
  711. LESPRO(NMAT)='CONDUCTION'
  712.  
  713. ELSEIF (LESFOR(1).EQ.'MECANIQUE'.OR.
  714. & LESFOR(1).EQ.'POREUX' .OR.
  715. & LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  716. C +------------------------------------------------------------------------------+
  717. C | Defaut pour une FORMULATION MECANIQUE, POREUX ou MAGNETODYNAMIQUE : ISOTROPE |
  718. C +------------------------------------------------------------------------------+
  719. NMAT=NMAT+1
  720. LESPRO(NMAT)='ISOTROPE'
  721.  
  722. ELSEIF (LESFOR(1).EQ.'DIFFUSION') THEN
  723. C +----------------------------------------------+
  724. C | Defaut pour une FORMULATION DIFFUSION : FICK |
  725. C +----------------------------------------------+
  726. NMAT = NMAT+1
  727. LESPRO(NMAT)='FICK'
  728.  
  729. ELSEIF (LESFOR(1).EQ.'NAVIER_STOKES'.OR.
  730. & LESFOR(1).EQ.'EULER') THEN
  731. C +----------------------------------------------------------------+
  732. C | Defaut pour une FORMULATION NAVIER_STOKES OU EULER : NEWTONIEN |
  733. C +----------------------------------------------------------------+
  734. NMAT = 1
  735. LESPRO(NMAT)='NEWTONIEN'
  736.  
  737. ELSEIF (LESFOR(1).EQ.'FISSURE') THEN
  738. C +-------------------------------------+
  739. C | Defaut pour une FORMULATION FISSURE |
  740. C +-------------------------------------+
  741. NMAT = 3
  742. LESPRO(1)='MASS'
  743. LESPRO(2)='PARF'
  744. LESPRO(3)='POISEU_BLASIUS'
  745.  
  746. ELSEIF(LESFOR(1).EQ.'CONTACT') THEN
  747. C +---------------------------------------------------+
  748. C | Defaut pour une FORMULATION CONTACT : UNILATERAL |
  749. C +---------------------------------------------------+
  750. NMAT=1
  751. LESPRO(1)='UNILATERAL'
  752. ENDIF
  753. ENDIF
  754.  
  755.  
  756. IF(LESFOR(1).EQ.'CHANGEMENT_PHASE' ) THEN
  757. C +------------------------------------------------------------------------+
  758. C | FORMULATION CHANGEMENT_PHASE : LECTURE DES INCONNUES PRIMALES & DUALES |
  759. C +------------------------------------------------------------------------+
  760. CALL LIRMOT(MOINCO,NBDIF,IPLAC,0)
  761. IF (IPLAC.EQ.0) THEN
  762. CALL ERREUR(1093)
  763. RETURN
  764.  
  765. ELSE
  766. CALL LIRCHA(CHPRIM,1,IRETI)
  767. IF (IERR.NE.0) RETURN
  768. CALL LIRCHA(CHDUAL,1,IRETE)
  769. IF (IERR.NE.0) RETURN
  770. JGN=4
  771. JGM=2
  772. SEGINI,MLMOT1
  773. MLMOT1.MOTS(1)=CHPRIM
  774. MLMOT1.MOTS(2)=CHDUAL
  775. SEGACT,MLMOT1*NOMOD
  776. ipridu=MLMOT1
  777. ENDIF
  778. ENDIF
  779.  
  780. C Lecture eventuelle des types d'ELEMENTS FINIS a utiliser
  781. 43 ITEF=0
  782. IF (NBTEF.EQ.0) GOTO 2
  783. CALL MESLIR(-178)
  784. 1 IF (ITEF.NE.0) CALL MESLIR(-177)
  785. CALL LIRMOT(MOTEF,NBTEF,LETEF,0)
  786. IF (IERR.NE.0) RETURN
  787. IF (LETEF.EQ.0) GOTO 2
  788. ITEF=ITEF+1
  789. LESTEF(ITEF)=MOTEF(LETEF)
  790. GOTO 1
  791.  
  792. c Lecture eventuelle de listmots
  793. 2 continue
  794. call lirobj('LISTMOTS',jlmot1,0,irmot1)
  795. if (irmot1.eq.1) call lirobj('LISTMOTS',jlmot2,1,irmot2)
  796.  
  797. C lecture pour mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
  798. C En formulations 'MECANIQUE' et 'POREUX' : detection d'une loi non
  799. C lineaire externe, le cas echeant saisie de donnees complementaires.
  800. C Caracterisation : loi non lineaire externe si
  801. C - famille 'VISCO_EXTERNE' ou
  802. C - famille 'NON_LINEAIRE', materiau 'UTILISATEUR'.
  803. C si pas loi externe lecture eventuelle des parametres externes
  804. LMEEXT=.FALSE.
  805. LMEVIX=.FALSE.
  806. LMENLX=.FALSE.
  807. LMENUM = 0
  808. LMENOM = ' '
  809. LMELIB = ' '
  810. LMEFCT = ' '
  811. LMELGB = 0
  812. LMELGT = 0
  813. LMEPTR = 0
  814. LMEIVI = 0
  815.  
  816. IF ( (NFOR.EQ.1).AND.
  817. . (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') ) THEN
  818. DO i=1,NMAT
  819. IF (LESPRO(i).EQ.'VISCO_EXTERNE') THEN
  820. LMEVIX=.TRUE.
  821. GOTO 203
  822. ENDIF
  823. ENDDO
  824.  
  825. IF (.NOT.LMEVIX) THEN
  826. DO i=1,NMAT
  827. IF (LESPRO(i).EQ.'UTILISATEUR') THEN
  828. LMENLX = .TRUE.
  829. GOTO 203
  830. ENDIF
  831. ENDDO
  832. ENDIF
  833. C........N.B. LMEEXT exprime la condition (NFOR.EQ.1) ET
  834. C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
  835. 203 LMEEXT = LMEVIX.OR.LMENLX
  836. IF ( LMEEXT ) THEN
  837. C lecture et verif des noms des materiaux, des
  838. C noms des variables internes, des noms des parametre externe pour
  839. C loi externes
  840. 210 CALL LIRMOT(MOEXT,NBEXT,LEXT,0)
  841. C Si on ne trouve plus l'un des mots cles attendus, on sort
  842. IF (LEXT.EQ.0) GOTO 211
  843. C Lecture d'un entier sous 'NUME_LOI'
  844. IF (LEXT.EQ.1) THEN
  845. CALL LIRENT(LMENUM,1,IRET)
  846. IF (IERR.NE.0) RETURN
  847. C Valeur illicite du numero de la loi (superieur ou egal a 1)
  848. IF (LMENUM.LT.1 .OR. LMENUM.GE.1000000) THEN
  849. INTERR(1) = LMENUM
  850. CALL ERREUR(36)
  851. CALL ERREUR(947)
  852. RETURN
  853. ENDIF
  854. C Lecture du nom de la loi sous 'NOM_LOI'
  855. ELSE IF (LEXT.EQ.2) THEN
  856. MOTEMP = ' '
  857. CALL LIRCHA(MOTEMP,1,IRET)
  858. IF (IERR.NE.0) RETURN
  859. IRET = LONG(MOTEMP(1:IRET))
  860. IF (IRET.GT.16) THEN
  861. INTERR(1) = IRET
  862. MOTERR = MOTEMP(1:IRET)
  863. CALL ERREUR(-2)
  864. CALL ERREUR(36)
  865. RETURN
  866. ELSE IF (IRET.LE.0) THEN
  867. INTERR(1) = IRET
  868. MOTERR = 'NOM_LOI'
  869. CALL ERREUR(-2)
  870. CALL ERREUR(36)
  871. RETURN
  872. ENDIF
  873. LMENOM(1:IRET) = MOTEMP(1:IRET)
  874. C Lecture d'un objet LISTMOTS sous 'PARA_LOI'
  875. ELSE IF (LEXT.EQ.3) THEN
  876. CALL LIROBJ('LISTMOTS',LUPARX,1,IRET)
  877. IF (IERR.NE.0) RETURN
  878. C Lecture d'un objet LISTMOTS sous 'C_MATERIAU'
  879. ELSE IF (LEXT.EQ.4) THEN
  880. CALL LIROBJ('LISTMOTS',LUCMAT,1,IRET)
  881. IF (IERR.NE.0) RETURN
  882. C Lecture d'un objet LISTMOTS sous 'C_VARINTER'
  883. ELSE IF (LEXT.EQ.5) THEN
  884. CALL LIROBJ('LISTMOTS',LUCVAR,1,IRET)
  885. IF (IERR.NE.0) RETURN
  886. C Lecture du chemin de la bibliotheque de la loi
  887. ELSE IF (LEXT.EQ.6) THEN
  888. MOTEMP = ' '
  889. CALL LIRCHA(MOTEMP,1,IRET)
  890. IF (IERR.NE.0) RETURN
  891. IRET = LONG(MOTEMP(1:IRET))
  892. IF (IRET.GT.510) THEN
  893. INTERR(1) = IRET
  894. MOTERR = MOTEMP(1:40)
  895. CALL ERREUR(-2)
  896. CALL ERREUR(36)
  897. RETURN
  898. ENDIF
  899. LMELIB(1:IRET) = MOTEMP(1:IRET)
  900. LMELGB = IRET
  901. LMEPTR = IRET
  902. C Lecture du nom de la fonction de la loi
  903. ELSE IF (LEXT.EQ.7) THEN
  904. MOTEMP = ' '
  905. CALL LIRCHA(MOTEMP,1,IRET)
  906. IF (IERR.NE.0) RETURN
  907. IRET = LONG(MOTEMP(1:IRET))
  908. IF (IRET.LE.0 .OR. IRET.GT.72) THEN
  909. INTERR(1) = IRET
  910. MOTERR = MOTEMP(1:40)
  911. CALL ERREUR(-2)
  912. CALL ERREUR(36)
  913. RETURN
  914. ENDIF
  915. LMEFCT(1:IRET) = MOTEMP(1:IRET)
  916. LMELGT = IRET
  917. ENDIF
  918. C On repete jusqu'a ce qu'on ne trouve plus aucun des
  919. C mots cles attendus, regle de surcharge le cas echeant
  920. GOTO 210
  921. 211 CONTINUE
  922. C...........Verifications sur les donnees
  923. C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire)
  924. IF (LMENUM.EQ.0 .AND. LMENOM.EQ.' ') THEN
  925. if (LMELGT.eq.0) then
  926. CALL ERREUR(641)
  927. RETURN
  928. endif
  929. ENDIF
  930. IF (LMENUM.NE.0 .AND. LMENOM.NE.' ') THEN
  931. MOTERR(1:16) = 'NUME_LOINOM_LOI '
  932. CALL ERREUR(135)
  933. RETURN
  934. ENDIF
  935. C Les liste des composantes ne doivent pas etre vides.
  936. DO i = 1, 3
  937. IF (i.EQ.1) mlmots = LUPARX
  938. IF (i.EQ.2) mlmots = LUCMAT
  939. IF (i.EQ.3) mlmots = LUCVAR
  940. IF (MLMOTS.NE.0) THEN
  941. SEGACT,mlmots
  942. NBCOMP = mlmots.mots(/2)
  943. IF (NBCOMP.EQ.0) THEN
  944. CALL ERREUR(964)
  945. RETURN
  946. ENDIF
  947. ENDIF
  948. ENDDO
  949. C Dans le cas d'un modele NON_LINEAIRE UTILISATEUR, on rajoute en fin de
  950. C liste des proprietes du modele, le numero ou le nom de la loi attribue
  951. C par l'utilisateur.
  952. NMAT = NMAT + 1
  953. LESPRO(NMAT) = ' '
  954. IF (LMENUM.EQ.0) THEN
  955. LESPRO(NMAT) = LMENOM
  956. if (LMELGT.gt.0.and.LMENOM.eq.' ') then
  957. c* On espere mettre un numero "unique" dans le nom !
  958. segini,ilmora
  959. write(LESPRO(NMAT)(1:16),'(I16)') ilmora
  960. segsup,ilmora
  961. endif
  962. ELSE
  963. WRITE(LESPRO(NMAT)(1:16),'(I16)') LMENUM
  964. ENDIF
  965. C Verifications pour une loi 'NON_LINEAIRE' 'UTILISATEUR'
  966. IF ( LMENLX ) THEN
  967. C Il manque les composantes materielles sous 'C_MATERIAU'
  968. IF (LUCMAT.EQ.0) THEN
  969. CALL ERREUR(641)
  970. RETURN
  971. ENDIF
  972. C La liste des composantes materielles saisie sous
  973. C 'C_MATERIAU' ne doit pas etre vide
  974. MLMOTS=LUCMAT
  975. SEGACT,MLMOTS
  976. NBCOMP = MOTS(/2)
  977. IF (NBCOMP.EQ.0) THEN
  978. CALL ERREUR(964)
  979. RETURN
  980. ENDIF
  981. ENDIF
  982. C Dans le cas d'une libraire externe, quelques verifications puis
  983. C recherche du pointeur de la fonction externe
  984. IF (LMEPTR.GT.0) THEN
  985. IF (LMELGT.EQ.0) THEN
  986. IF (LMENUM.EQ.0) THEN
  987. IRET = LONG(LMENOM)
  988. i_z = INDEX(LMENOM(1:IRET),' ')
  989. IF (i_z.NE.0) THEN
  990. write(ioimp,*) 'PAS D ESPACE dans NOM_LOI en cas de LIB_LOI'
  991. CALL ERREUR(21)
  992. RETURN
  993. ENDIF
  994. LMEFCT(1:IRET) = LMENOM(1:IRET)
  995. LMELGT = IRET
  996. ELSE
  997. IRET = 0
  998. DO i = 1, 16
  999. IRET = IRET + 1
  1000. IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 220
  1001. ENDDO
  1002. 220 LMEFCT = 'umat_'//LESPRO(NMAT)(IRET:16)
  1003. LMELGT = 22-IRET
  1004. ENDIF
  1005. ENDIF
  1006. LMELIB = LMELIB(1:LMELGB)//CHAR(0)
  1007. LMEFCT = LMEFCT(1:LMELGT)//CHAR(0)
  1008. LMEPTR = 0
  1009. IP =-1
  1010. CALL PTRLOI(LMELIB,LMELGB,LMEFCT,LMELGT,IP,LMEPTR)
  1011. IF (LMEPTR.LE.0) THEN
  1012. MOTERR(1 :16)=LMEFCT
  1013. MOTERR(17:40)=LMELIB
  1014. CALL ERREUR(1113)
  1015. RETURN
  1016. ENDIF
  1017. ENDIF
  1018. ELSE
  1019. C si pas lois externes lecture des noms des parametres externes
  1020. CALL LIRMOT(MOEXT(2),1,LEXT,0)
  1021. If(lext.ne.0) then
  1022. CALL LIROBJ('LISTMOTS',luparx,1,iret)
  1023. IF(IERR.NE.0) return
  1024. endif
  1025. ENDIF
  1026. C Verifications sur les parametres, si declares
  1027. IF (luparx.GT.0) THEN
  1028. C Si la temperature 'T ' fait partie des parametres de
  1029. C la loi, elle doit etre declaree en tete
  1030. mlmots=luparx
  1031. SEGACT,MLMOTS
  1032. NBPARA=MOTS(/2)
  1033. IF (NBPARA.GT.0) THEN
  1034. DO IP = 1, NBPARA
  1035. IF (MOTS(IP).EQ.'T ') THEN
  1036. IF (IP.GT.1) THEN
  1037. CALL ERREUR(948)
  1038. RETURN
  1039. ENDIF
  1040. GOTO 221
  1041. ENDIF
  1042. ENDDO
  1043. 221 CONTINUE
  1044. ENDIF
  1045. C Pas de parametres redondants
  1046. IF (NBPARA.GT.1) THEN
  1047. DO 230 IP1 = 1, NBPARA-1
  1048. PAR1 = MOTS(IP1)
  1049. DO 231 IP2 = IP1+1, NBPARA
  1050. IF (MOTS(IP2).EQ.PAR1) THEN
  1051. CALL ERREUR(949)
  1052. RETURN
  1053. ENDIF
  1054. 231 CONTINUE
  1055. 230 CONTINUE
  1056. ENDIF
  1057. ENDIF
  1058. ENDIF
  1059. C fin lecture mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
  1060.  
  1061. C Formulation 'DIFFUSION' : oooooooooooooooooooooooooooooooooooooooooooo
  1062. C - Detection d'une loi non lineaire externe (mot-cle 'UTILISATEUR')
  1063. C - Detection de la quantite de l'effet Soret (mot-cle 'SORET')
  1064. C - Lecture de l'inconnue "diffusant" (mot-cle 'INCO')
  1065. C 3 CONTINUE
  1066. LDIEXT = .FALSE.
  1067. LDISOR = .FALSE.
  1068. LDINUM = 0
  1069. LDINOM = ' '
  1070. LDILIB = ' '
  1071. LDIFCT = ' '
  1072. LDILGB = 0
  1073. LDILGT = 0
  1074. LDIPTR = 0
  1075. IF (NFOR.EQ.1 .AND. LESFOR(1).EQ.'DIFFUSION') THEN
  1076. C -- Recherche des informations sur la presence d'une loi externe --
  1077. DO i=1,NMAT
  1078. LDIEXT = LESPRO(i).EQ.'UTILISATEUR'
  1079. LDISOR = LESPRO(i).EQ.'SORET'
  1080. ENDDO
  1081. C - Lecture des informations pour la loi externe
  1082. IF (LDIEXT) THEN
  1083. 310 CONTINUE
  1084. CALL LIRMOT(MOEXT,NBEXT,LEXT,0)
  1085. IF (LEXT.EQ.0) GOTO 311
  1086. C Lecture d'un entier sous 'NUME_LOI'
  1087. IF (LEXT.EQ.1) THEN
  1088. CALL LIRENT(LDINUM,1,IRET)
  1089. IF (IERR.NE.0) RETURN
  1090. IF (LDINUM.LT.1 .OR. LDINUM.GE.1000000) THEN
  1091. INTERR(1) = LDINUM
  1092. CALL ERREUR(36)
  1093. CALL ERREUR(947)
  1094. RETURN
  1095. ENDIF
  1096. C Lecture du nom de la loi sous 'NOM_LOI'
  1097. ELSE IF (LEXT.EQ.2) THEN
  1098. MOTEMP = ' '
  1099. CALL LIRCHA(MOTEMP,1,IRET)
  1100. IF (IERR.NE.0) RETURN
  1101. IRET = LONG(MOTEMP(1:IRET))
  1102. IF (IRET.GT.16) THEN
  1103. INTERR(1) = IRET
  1104. MOTERR = MOTEMP(1:40)
  1105. CALL ERREUR(-2)
  1106. CALL ERREUR(36)
  1107. RETURN
  1108. ELSE IF (IRET.LE.0) THEN
  1109. INTERR(1) = IRET
  1110. MOTERR = 'NOM_LOI'
  1111. CALL ERREUR(-2)
  1112. CALL ERREUR(36)
  1113. RETURN
  1114. ENDIF
  1115. LDINOM(1:IRET) = MOTEMP(1:IRET)
  1116. C Lecture d'un objet LISTMOTS sous 'PARA_LOI'
  1117. ELSE IF (LEXT.EQ.3) THEN
  1118. CALL LIROBJ('LISTMOTS',luparx,1,IRET)
  1119. IF (IERR.NE.0) RETURN
  1120. C Lecture d'un objet LISTMOTS sous 'C_MATERIAU'
  1121. ELSE IF (LEXT.EQ.4) THEN
  1122. CALL LIROBJ('LISTMOTS',lucmat,1,IRET)
  1123. IF (IERR.NE.0) RETURN
  1124. C Lecture d'un objet LISTMOTS sous 'C_VARINTER'
  1125. ELSE IF (LEXT.EQ.5) THEN
  1126. CALL LIROBJ('LISTMOTS',lucvar,1,IRET)
  1127. IF (IERR.NE.0) RETURN
  1128. C Lecture du chemin de la bibliotheque de la loi
  1129. ELSE IF (LEXT.EQ.6) THEN
  1130. MOTEMP = ' '
  1131. CALL LIRCHA(MOTEMP,1,IRET)
  1132. IF (IERR.NE.0) RETURN
  1133. IRET = LONG(MOTEMP(I:IRET))
  1134. IF (IRET.GT.510) THEN
  1135. INTERR(1) = IRET
  1136. MOTERR = MOTEMP(1:40)
  1137. CALL ERREUR(-2)
  1138. CALL ERREUR(36)
  1139. RETURN
  1140. ENDIF
  1141. LDILIB(1:IRET) = MOTEMP(1:IRET)
  1142. LDILGB = IRET
  1143. LDIPTR = IRET
  1144. C Lecture du nom de la fonction de la loi
  1145. ELSE IF (LEXT.EQ.7) THEN
  1146. MOTEMP = ' '
  1147. CALL LIRCHA(MOTEMP,1,IRET)
  1148. IF (IERR.NE.0) RETURN
  1149. IRET = LONG(MOTEMP(1:IRET))
  1150. IF (IRET.LE.0 .OR. IRET.GT.72) THEN
  1151. INTERR(1) = IRET
  1152. MOTERR = MOTEMP(1:40)
  1153. CALL ERREUR(-2)
  1154. CALL ERREUR(36)
  1155. RETURN
  1156. ENDIF
  1157. LDIFCT(1:IRET) = MOTEMP(1:IRET)
  1158. LDILGT = IRET
  1159. ENDIF
  1160. GOTO 310
  1161. 311 CONTINUE
  1162. C Verifications des informations obligatoires de la loi externe
  1163. C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire)
  1164. IF (LDINUM.EQ.0 .AND. LDINOM.EQ.' ') THEN
  1165. if (LDILGT.eq.0) then
  1166. CALL ERREUR(641)
  1167. RETURN
  1168. endif
  1169. ENDIF
  1170. IF (LDINUM.NE.0 .AND. LDINOM.NE.' ') THEN
  1171. MOTERR(1:16) = 'NUME_LOINOM_LOI '
  1172. CALL ERREUR(135)
  1173. RETURN
  1174. ENDIF
  1175. C Il manque la liste 'C_MATERIAU'
  1176. IF (lucmat.EQ.0) THEN
  1177. CALL ERREUR(641)
  1178. RETURN
  1179. ENDIF
  1180. C Les liste des composantes ne doivent pas etre vides.
  1181. DO i = 1, 3
  1182. IF (i.EQ.1) MLMOTS = luparx
  1183. IF (i.EQ.2) MLMOTS = lucmat
  1184. IF (i.EQ.3) MLMOTS = lucvar
  1185. IF (MLMOTS.NE.0) THEN
  1186. SEGACT,MLMOTS
  1187. NBCOMP = MOTS(/2)
  1188. IF (NBCOMP.EQ.0) THEN
  1189. CALL ERREUR(964)
  1190. RETURN
  1191. ENDIF
  1192. ENDIF
  1193. ENDDO
  1194. C Dans le cas d'un modele UTILISATEUR, on rajoute en fin de
  1195. C liste des proprietes du modele, le numero attribue par l'utilisateur.
  1196. NMAT = NMAT + 1
  1197. LESPRO(NMAT) = ' '
  1198. IF (LDINUM.EQ.0) THEN
  1199. LESPRO(NMAT) = LDINOM
  1200. if (LDILGT.gt.0.and.LDINOM.eq.' ') then
  1201. c* On espere mettre un numero "unique" dans le nom !
  1202. segini,ilmora
  1203. write(LESPRO(NMAT)(1:16),'(I16)') ilmora
  1204. segsup,ilmora
  1205. endif
  1206. ELSE
  1207. WRITE(LESPRO(NMAT)(1:16),'(I16)') LDINUM
  1208. ENDIF
  1209. C Dans le cas d'une libraire externe, quelques verifications puis
  1210. C recherche du pointeur de la fonction externe
  1211. IF (LDIPTR.GT.0) THEN
  1212. IF (LDILGT.EQ.0) THEN
  1213. IF (LDINUM.EQ.0) THEN
  1214. IRET = LONG(LDINOM)
  1215. i_z = INDEX(LDINOM(1:IRET),' ')
  1216. IF (i_z.NE.0) THEN
  1217. write(ioimp,*) 'PAS D ESPACE dans NOM_LOI en cas de LIB_LOI'
  1218. CALL ERREUR(21)
  1219. RETURN
  1220. ENDIF
  1221. LDIFCT(1:IRET) = LDINOM(1:IRET)
  1222. LDILGT = IRET
  1223. ELSE
  1224. IRET = 0
  1225. DO i = 1, 16
  1226. IRET = IRET + 1
  1227. IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 320
  1228. ENDDO
  1229. 320 LDIFCT = 'umat_'//LESPRO(NMAT)(IRET:16)
  1230. LDILGT = 22-IRET
  1231. ENDIF
  1232. ENDIF
  1233. LDILIB = LDILIB(1:LDILGB)//CHAR(0)
  1234. LDIFCT = LDIFCT(1:LDILGT)//CHAR(0)
  1235. LDIPTR = 0
  1236. IP =-1
  1237. CALL PTRLOI(LDILIB,LDILGB,LDIFCT,LDILGT,IP,LDIPTR)
  1238. IF (LDIPTR.LE.0) THEN
  1239. MOTERR(1 :16)=LDIFCT
  1240. MOTERR(17:40)=LDILIB
  1241. CALL ERREUR(1113)
  1242. RETURN
  1243. ENDIF
  1244. ENDIF
  1245. ENDIF
  1246. C - Lecture des informations pour la loi Soret :
  1247. C - quantite dont le gradient est l'origine de l'effet ('T' par defaut)
  1248. IF (LDISOR) THEN
  1249. mlmots = 0
  1250. CHARIN = 'T '
  1251. C Lecture du mot-cle 'PARA_LOI' et donnees associees
  1252. CALL LIRMOT(MOEXT(2),1,LEXT,0)
  1253. IF (IERR.NE.0) RETURN
  1254. IF (LEXT.EQ.1) THEN
  1255. CALL LIROBJ('LISTMOTS',mlmots,0,IRET)
  1256. IF (IERR.NE.0) RETURN
  1257. IF (IRET.EQ.0) THEN
  1258. CALL LIRCHA(CHARIN,1,IRETI)
  1259. IF (IERR.NE.0) RETURN
  1260. IRETI=LONG(CHARIN)
  1261. IF (IRETI.EQ.0) CALL ERREUR(643)
  1262. ELSE
  1263. SEGACT,mlmots
  1264. NBCOMP = mots(/2)
  1265. IF (NBCOMP.EQ.0) THEN
  1266. CALL ERREUR(964)
  1267. ELSE
  1268. CHARIN = MOTS(1)
  1269. IRETI = LONG(CHARIN)
  1270. IF (IRETI.EQ.0) CALL ERREUR(643)
  1271. ENDIF
  1272. ENDIF
  1273. IF (IERR.NE.0) RETURN
  1274. IRETMA = 2
  1275. C*8 IRETMA = 6
  1276. IF (IRETI.GT.IRETMA) THEN
  1277. INTERR(1) = IRETMA
  1278. MOTERR(1:8) = CHARIN(1:IRETI)
  1279. CALL ERREUR(-353)
  1280. ENDIF
  1281. IRETI = MIN(IRETI,IRETMA)
  1282. CHARIN(IRETI+1:8) = ' '
  1283. ENDIF
  1284. JGM = 1
  1285. JGN = 8
  1286. SEGINI,mlmots
  1287. mots(1) = CHARIN
  1288. luparx = mlmots
  1289. ENDIF
  1290.  
  1291. C -- Pour la formulation DIFFUSION : lecture quantite (ddl) diffusant --
  1292. C -- On cherche a lire le mot 'INCO' suivi du nom de l'INCOnnue donne --
  1293. C -- soit par un LISTMOTS, soit par un MOT puis eventuellement du nom --
  1294. C -- de la grandeur DUALe donne par un objet de meme type que pour le --
  1295. C -- nom de l'inconnue. --
  1296. CALL LIRMOT(MOINCO,NBDIF,LEXT,0)
  1297. IF (LEXT.EQ.0) THEN
  1298. C*8 MDIINC='CONC '
  1299. C*8 MDIDUA='QCONC '
  1300. MDIINC='CO '
  1301. MDIDUA='QCO '
  1302. ELSE
  1303. MDIINC=' '
  1304. MDIDUA='Q '
  1305. CHARIN=' '
  1306. CHARRE=' '
  1307. CALL LIROBJ('LISTMOTS',mlmots,0,IRET)
  1308. IF (IERR.NE.0) RETURN
  1309. IF (mlmots.NE.0) THEN
  1310. SEGACT,mlmots
  1311. NBCOMP = MOTS(/2)
  1312. IF (NBCOMP.EQ.0) THEN
  1313. CALL ERREUR(643)
  1314. ELSE
  1315. CHARIN=MOTS(1)
  1316. IRETI=LONG(CHARIN)
  1317. IF (IRETI.EQ.0) CALL ERREUR(643)
  1318. ENDIF
  1319. IF (IERR.NE.0) RETURN
  1320. CALL LIROBJ('LISTMOTS',mlmots,0,IRETE)
  1321. IF (IERR.NE.0) RETURN
  1322. IF (mlmots.NE.0) THEN
  1323. SEGACT,mlmots
  1324. NBCOMP = MOTS(/2)
  1325. IF (NBCOMP.EQ.0) THEN
  1326. CALL ERREUR(643)
  1327. ELSE
  1328. CHARRE=MOTS(1)
  1329. IRETE=LONG(CHARRE)
  1330. IF (IRETE.EQ.0) CALL ERREUR(643)
  1331. ENDIF
  1332. IF (IERR.NE.0) RETURN
  1333. ENDIF
  1334. ELSE
  1335. CALL LIRCHA(CHARIN,1,IRETI)
  1336. IF (IERR.NE.0) RETURN
  1337. IRETI = LONG(CHARIN(1:IRETI))
  1338. IF (IRETI.EQ.0) THEN
  1339. CALL ERREUR(643)
  1340. RETURN
  1341. ENDIF
  1342. CALL LIRCHA(CHARRE,0,IRETE)
  1343. IF (IERR.NE.0) RETURN
  1344. IF (IRETE.GT.0) THEN
  1345. IRETE = LONG(CHARRE(1:IRETE))
  1346. IF (IRETE.EQ.0) THEN
  1347. CALL ERREUR(643)
  1348. RETURN
  1349. ENDIF
  1350. ENDIF
  1351. ENDIF
  1352. IRETMA = 2
  1353. C*8 IRETMA = 6
  1354. IF (IRETI.GT.IRETMA) THEN
  1355. INTERR(1) = IRETMA
  1356. MOTERR(1:8) = CHARIN(1:IRETI)
  1357. CALL ERREUR(-353)
  1358. ENDIF
  1359. IRETI = MIN(IRETI,IRETMA)
  1360. MDIINC(1:IRETI)=CHARIN(1:IRETI)
  1361. IF (IRETE.EQ.0) THEN
  1362. MDIDUA(2:1+IRETI)=MDIINC(1:IRETI)
  1363. ELSE
  1364. IRETMA = IRETMA + 2
  1365. IF (IRETE.GT.IRETMA) THEN
  1366. INTERR(1) = IRETMA
  1367. MOTERR(1:8) = CHARRE(1:IRETE)
  1368. CALL ERREUR(-353)
  1369. ENDIF
  1370. IRETE=MIN(IRETE,IRETMA)
  1371. MDIDUA(1:IRETE)=CHARRE(1:IRETE)
  1372. ENDIF
  1373. ENDIF
  1374. c* Verification des noms de primale et duale lues
  1375. CALL VERMDI(MDIINC,MDIDUA)
  1376. IF (IERR.NE.0) RETURN
  1377. c*
  1378. ENDIF
  1379. C Fin Formulation 'DIFFUSION' oooooooooooooooooooooooooooooooooooooooooo
  1380.  
  1381. C Lecture eventuelle du NOM de CONSTITUANT, du nombre de POINTs
  1382. C d'INTEGRATION, du point support pour les modes en DEFOrmations
  1383. C PLANEs GENEralisees, du nom de la phase, de la formulation non_locale
  1384. C fin des lecture en 22
  1385.  
  1386. C 674 CONTINUE
  1387. IPTGEN=0
  1388. IPMOD1=0
  1389. ngrig=0
  1390. ngmas=0
  1391. ngcon=0
  1392. npint=0
  1393. klcon= 0
  1394. kcons=0
  1395. ILIE=0
  1396. INLOC=0
  1397. INLVIA=0
  1398. LULVIA=0
  1399. 675 CALL LIRMOT(MOCON,NBCON,LECON,0)
  1400. IF (LECON.EQ.0) GOTO 22
  1401. IF (LECON.EQ.1) THEN
  1402. CALL LIRCHA(CONM,1,kcons)
  1403. IF (IERR.NE.0) RETURN
  1404. ELSE IF (LECON.EQ.2) THEN
  1405. 677 continue
  1406. legaus=0
  1407. CALL LIRMOT(MGAUSS,4,legaus,0)
  1408. if( legaus.eq.0.and.npint.eq.0) then
  1409. legaus=1
  1410. else
  1411. go to 675
  1412. endif
  1413. CALL LIRENT(NPINTT,1,IRET)
  1414. IF (IERR.NE.0) RETURN
  1415. if(legaus.eq.1) npint=npintt
  1416. if(legaus.eq.2) ngrig=npintt
  1417. if(legaus.eq.3) ngmas=npintt
  1418. if(legaus.eq.4) ngcon=npintt
  1419. MN3=1
  1420. IF (NPINT.ne.0.and.MOD(NPINT,2).EQ.0) THEN
  1421. CALL ERREUR(607)
  1422. ENDIF
  1423. go to 677
  1424. ELSE IF (LECON.EQ.3) THEN
  1425. CALL LIROBJ('POINT',IPTGEN,1,IRET)
  1426. IF (IERR.NE.0) RETURN
  1427. C On transforme le point en maillage de POI1 (avec un seul element)
  1428. CALL CRELEM(IPTGEN)
  1429. C On verifie s'il n'a pas deja ete preconditionne.
  1430. CALL CRECH1(IPTGEN,1)
  1431. meleme = IPTGEN
  1432. ELSE IF (LECON.EQ.4) THEN
  1433. CALL LIRCHA(PHAM,1,IRET)
  1434. IF(IERR.NE.0) RETURN
  1435. ELSE IF (LECON.EQ.5) THEN
  1436. CALL LIROBJ('MMODEL',IPMOD1,0,IRET)
  1437. IF (IERR.NE.0) RETURN
  1438. ELSE IF (LECON.EQ.6.OR.LECON.EQ.7) THEN
  1439. CALL LIROBJ('MMODEL',IPMOD2,0,IRET)
  1440. IF (IERR.NE.0) RETURN
  1441. if (ipmod2.gt.0) then
  1442. if (klcon.eq.0) then
  1443. nlcon = 10
  1444. segini plicon
  1445. endif
  1446. klcon = klcon + 1
  1447. if (klcon.gt.nlcon) then
  1448. nlcon = nlcon + 10
  1449. segadj plicon
  1450. endif
  1451. mlicon(klcon) = ipmod2
  1452. tlicon(klcon) = lecon
  1453. endif
  1454. C (fdp) option 'LIE' pour les JOI1
  1455. ELSE IF (LECON.EQ.9) THEN
  1456. ILIE=1
  1457. ELSE IF (LECON.EQ.10) THEN
  1458. IF(LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') THEN
  1459. CALL MODNLO(MNLOCA,NLODIM)
  1460. IF(NLODIM.GT.NLOMAX) THEN
  1461. CALL ERREUR(6)
  1462. ELSE
  1463. CALL LIRMOT(MNLOCA,NLODIM,INLOC,1)
  1464. IF(IERR.NE.0) RETURN
  1465. CALL LIRMOT(MNLVAR,1,INLVIA,1)
  1466. IF(IERR.NE.0) RETURN
  1467. CALL LIROBJ('LISTMOTS',LULVIA,1,IRET)
  1468. IF(IERR.NE.0) RETURN
  1469. ENDIF
  1470. ELSE
  1471. CALL ERREUR(251)
  1472. ENDIF
  1473. ENDIF
  1474. GOTO 675
  1475. 22 CONTINUE
  1476.  
  1477. C Recuperation des caracteristiques du MAILLAGE dans MELEME
  1478. C on se pose le pb du maillage non conforme itypel=48 (SURE)
  1479. c qui contient les relations de conformite
  1480. MELEME=IPGEOM
  1481. IF (IPGEOM .EQ. 0) THEN
  1482. MOTERR='MAILLAGE'
  1483. CALL ERREUR(471)
  1484. RETURN
  1485. ENDIF
  1486. SEGACT,MELEME
  1487. NSOU = MELEME.LISOUS(/1)
  1488. NSOU1 = MAX(1,NSOU)
  1489. C ICONFO=0
  1490. DO 38 INB=1,NSOU1
  1491. IF (NSOU.EQ.0) THEN
  1492. IPT2=MELEME
  1493. ELSE
  1494. IPT2=MELEME.LISOUS(INB)
  1495. SEGACT,IPT2
  1496. ENDIF
  1497. C IF (IPT2.ITYPEL.EQ.48) ICONFO=ICONFO+1
  1498. 38 CONTINUE
  1499. C
  1500. C Initialisation du segment MMODEL
  1501. C
  1502. N1 = NSOU1
  1503. SEGINI,MMODEL
  1504. IPMODE = MMODEL
  1505.  
  1506. C* Nom du constituant par defaut si non donne en entree
  1507. IF (kcons.EQ.0) WRITE(CONM,FMT='(I16)') IPMODE
  1508. C ** IF (kcons.EQ.0) CONM='MODELI'
  1509.  
  1510. IF (IReMOD.NE.0) GOTO 70
  1511. C Remplissage du segment MMODEL
  1512. IF (LESFOR(1).EQ.'NAVIER_STOKES') MN3=2
  1513. IF (LESFOR(1).EQ.'EULER') MN3=2
  1514. IF (LESFOR(1).EQ.'DARCY') MN3=2
  1515. IF (LESFOR(1).EQ.'THERMOHYDRIQUE' ) mn3=2
  1516. IF (LESFOR(1).EQ.'MECANIQUE'.OR.lesfor(1).EQ.'POREUX'.or.
  1517. $ nfor.EQ.2 .OR.LESFOR(1).EQ.'CHARGEMENT') THEN
  1518. IF(INLOC.NE.0) THEN
  1519. mn3=14
  1520. ELSE
  1521. mn3=12
  1522. ENDIF
  1523. ENDIF
  1524. IF (LESFOR(1).EQ.'LIQUIDE') mn3=12
  1525. IF (LESFOR(1).EQ.'LIAISON') mn3=12
  1526. IF (LESFOR(1).EQ.'ELECTROSTATIQUE') mn3=12
  1527. IF (LESFOR(1).EQ.'DIFFUSION') mn3=12
  1528.  
  1529. C***********************************************************************
  1530. C Boucle sur les maillages elementaires de IPGEOM
  1531. C***********************************************************************
  1532. DO 10 IM=1,NSOU1
  1533. IF (NSOU.EQ.0) THEN
  1534. IPT1 =MELEME
  1535. ELSE
  1536. IPT1 =MELEME.LISOUS(IM)
  1537. SEGACT,IPT1
  1538. ENDIF
  1539. ITYP1 =IPT1.ITYPEL
  1540. NBNN =IPT1.NUM(/1)
  1541.  
  1542. NOBMOD=0
  1543. IF (LESFOR(1).EQ.'CONTACT ') THEN
  1544. IF (IFROCA.NE.0) NOBMOD=2
  1545. IF (ifrtt .ne.0) NOBMOD=1
  1546.  
  1547. ELSEIF (LESFOR(1).EQ.'DIFFUSION ') THEN
  1548. NOBDIF = NOBMOD
  1549. NOBMOD = NOBMOD + 3
  1550. IF (LDIPTR.GT.0) NOBMOD = NOBMOD + 1
  1551. C* ELSEIF ( (NFOR.EQ.1).AND.
  1552. C* & ( LESFOR(1).EQ.'MECANIQUE ' .OR.
  1553. C* & LESFOR(1).EQ.'POREUX ')) THEN
  1554.  
  1555. C* Modeles utilisateur en MECANIQUE :
  1556. ELSEIF (LMEEXT) THEN
  1557. NOBMEC = NOBMOD
  1558. IF (LMEPTR.GT.0) NOBMOD = NOBMOD + 4
  1559. IF (LMEVIX ) NOBMOD = NOBMOD + 2
  1560.  
  1561. ELSEIF (lesfor(1).eq.'METALLURGIE ') THEN
  1562. C On rangera les pointeurs sur les ListMots Phases,
  1563. C Reactifs, Produits et Types de Reactions dans IVAMOD
  1564. NOBMOD = 4
  1565.  
  1566. ELSEIF (lesfor(1).eq.'CHANGEMENT_PHASE') THEN
  1567. C On rangera : -le LISTMOTS des inconnues primales et duales dedans
  1568. C -le MAILLAGE des MULTIPLICATEURS 'LX'
  1569. NOBMOD = 2
  1570. ENDIF
  1571. if(iraye.eq.1) nobmod=2*icavit+isyme*idim+ifacaf*4
  1572.  
  1573. SEGINI,IMODEL
  1574. KMODEL(IM)=IMODEL
  1575. IMAMOD=IPT1
  1576.  
  1577. IF (LESFOR(1).EQ.'CONTACT ')THEN
  1578. IF (IFROCA.EQ.1) THEN
  1579. imamod=ipgeo2
  1580. ipt3=ipgeo2
  1581. segact ipt3
  1582. ityp1=ipt3.itypel
  1583. TYMODE(1)='MAILLAGE'
  1584. IVAMOD(1)=IPGEOM
  1585. TYMODE(2)='MAILLAGE'
  1586. IVAMOD(2)=IBETON
  1587. ipgeom=ipgeo2
  1588. ENDIF
  1589. IF (ifrtt.eq.1) then
  1590. ivamod(1)=ipgeo2
  1591. tymode(1)='MAILLAGE'
  1592. if (ipgeo2.eq.0) then
  1593. call erreur(641)
  1594. return
  1595. endif
  1596. ENDIF
  1597.  
  1598. ELSEIF (lesfor(1).eq.'METALLURGIE ') then
  1599. C lucvar : les noms des phases
  1600. IVAMOD(1) = lucvar
  1601. TYMODE(1) = 'LISTMOTS'
  1602. C reacti : les noms des reactifs
  1603. IVAMOD(2) = ireact
  1604. TYMODE(2) = 'LISTMOTS'
  1605. C produi : les noms des produits
  1606. IVAMOD(3) = iprodu
  1607. TYMODE(3) = 'LISTMOTS'
  1608. C lucmat : les noms des types de reactions
  1609. IVAMOD(4) = lucmat
  1610. TYMODE(4) = 'LISTMOTS'
  1611.  
  1612. ELSEIF (lesfor(1).eq.'CHANGEMENT_PHASE') then
  1613. C ipridu : les noms des variables primales et duales
  1614. IVAMOD(1) = ipridu
  1615. TYMODE(1) = 'LISTMOTS'
  1616. CALL IMPP1(IPT1,ipgeo2)
  1617. C ipgeo2 : MAILLAGE support des Multiplicateurs de Lagrange ('MULT')
  1618. IVAMOD(2) = ipgeo2
  1619. TYMODE(2) ='MAILLAGE'
  1620.  
  1621. ELSEIF (LESFOR(1).EQ.'THERMIQUE')THEN
  1622. if(iraye.ne.0) then
  1623. limora(im)= nobmod+1-n1
  1624. if(icavit.ne.0) then
  1625. tymode(1)='ENTIER'
  1626. ivamod(1)=nbga
  1627. tymode(2)='ENTIER'
  1628. ivamod(2)=nbdang
  1629. if(isyme.eq.1) then
  1630. tymode(3)='POINT'
  1631. tymode(4)='POINT'
  1632. if(idim.eq.3)tymode(5)='POINT'
  1633. ivamod(3)=ipp1
  1634. ivamod(4)=ipp2
  1635. if(idim.eq.3)ivamod(5)=ipp3
  1636. endif
  1637. endif
  1638. if(ifacaf.ne.0) then
  1639. tymode(1)='MAILLAGE'
  1640. tymode(2)='MAILLAGE'
  1641. tymode(3)='MAILLAGE'
  1642. tymode(4)='MMODEL'
  1643. ivamod(1)= ipfac1
  1644. ivamod(2)= ipfac2
  1645. ivamod(3)= ipfac3
  1646. ivamod(4)= imoco
  1647. endif
  1648. endif
  1649.  
  1650. ELSEIF (LESFOR(1).EQ.'DIFFUSION') THEN
  1651. TYMODE(NOBDIF+1)=MDIINC
  1652. IVAMOD(NOBDIF+1)=LDINUM
  1653. TYMODE(NOBDIF+2)=MDIDUA
  1654. IVAMOD(NOBDIF+2)=LDINUM
  1655. IF (LDIPTR.GT.0) THEN
  1656. CALL POSCHA(LDILIB(1:LDILGB)//'='//LDIFCT(1:LDILGT),i_z)
  1657. TYMODE(NOBDIF+3)='LDIEXT '
  1658. IVAMOD(NOBDIF+3)= LDIPTR
  1659. TYMODE(NOBDIF+4)='MOT '
  1660. IVAMOD(NOBDIF+4)= i_z
  1661. ENDIF
  1662.  
  1663. ELSEIF (LMEEXT) THEN
  1664. C Modeles utilisateur en MECANIQUE :
  1665. IF (LMEPTR.GT.0) THEN
  1666. C Indicateur 'LMEEXT' pour retrouver ses petits
  1667. CALL POSCHA('LMEEXT ',I_POS)
  1668. TYMODE(NOBMEC+1)='MOT '
  1669. IVAMOD(NOBMEC+1)= I_POS
  1670.  
  1671. C Pointeur vers la loi dans le DLL (donné par PTRLOI)
  1672. TYMODE(NOBMEC+2)='ENTIER '
  1673. IVAMOD(NOBMEC+2)= LMEPTR
  1674.  
  1675. C LMELIB : Adresse du DLL
  1676. CALL POSCHA(LMELIB(1:LMELGB),I_POS)
  1677. TYMODE(NOBMEC+3)='MOT '
  1678. IVAMOD(NOBMEC+3)= I_POS
  1679.  
  1680. C LMEFCT : Nom de la fonction dans le DLL
  1681. CALL POSCHA(LMEFCT(1:LMELGT),I_POS)
  1682. TYMODE(NOBMEC+4)='MOT '
  1683. IVAMOD(NOBMEC+4)= I_POS
  1684. NOBMEC = NOBMEC + 4
  1685. ENDIF
  1686.  
  1687. IF (LMEVIX) THEN
  1688. LMEIVI = NOBMEC + 1
  1689. TYMODE(LMEIVI)='IVIEX '
  1690. IVAMOD(LMEIVI)=0
  1691. ENDIF
  1692. ENDIF
  1693.  
  1694. CONMOD=CONM
  1695. conmod(17:24)=PHAM
  1696. IF(LESFOR(1).EQ.'LIAISON'.AND.klcon.gt.0) THEN
  1697. C kich liaison conditionelle
  1698. do ilc = 1,klcon
  1699. mmode2 = mlicon(ilc)
  1700. segact mmode2
  1701. if (mmode2.kmodel(/1).gt.1) then
  1702. C liaison conditionnelle mal specifiee
  1703. call erreur(5)
  1704. return
  1705. endif
  1706. imode2 = mmode2.kmodel(1)
  1707. segact imode2
  1708. if (imode2.formod(1).ne.'LIAISON') THEN
  1709. call erreur(5)
  1710. return
  1711. endif
  1712. if (tlicon(ilc).eq.6) TYMODE(ilc)='CONDINFE'
  1713. if (tlicon(ilc).eq.7) TYMODE(ilc)='CONDSUPE'
  1714. IVAMOD(ilc)=IMODE2
  1715. enddo
  1716. segsup plicon
  1717. ENDIF
  1718.  
  1719. C +--------------------------------------------------------------------+
  1720. C | Determination de la valeur de NEFMOD pour IMODEL |
  1721. C +--------------------------------------------------------------------+
  1722. C Affectation du type d'ELEMENTS FINIS si donnes par utilisateur
  1723.  
  1724. C cas des SURE (relation de conformite) :
  1725. C NEPAPA = si EF specifique demande -> on utilise ses inconnues
  1726. NEPAPA=0
  1727. IF(ITYP1.eq.48) then
  1728.  
  1729. NEFMOD=259
  1730. IF (ITEF.GT.0) THEN
  1731. DO i=1,ITEF
  1732. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1733. IF (MELE.NE.0) NEPAPA = MELE
  1734. ENDDO
  1735. ENDIF
  1736. IF(NEPAPA.EQ.0) THEN
  1737. c 2D -> on choisit les inconnues du QUA4 pour toute formulation
  1738. IF(IDIM.EQ.2) THEN
  1739. NEPAPA=8
  1740. c 3D -> on choisit les inconnues du CUB8 pour toute formulation
  1741. ELSEIF(IDIM.EQ.3) THEN
  1742. NEPAPA=14
  1743. ELSE
  1744. CALL ERREUR(610)
  1745. ENDIF
  1746. ENDIF
  1747. GOTO 11
  1748. ENDIF
  1749. IF (ITEF.NE.0) THEN
  1750. C Cas de la FORMULATION 'NAVIER_STOKES'
  1751. IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN
  1752. IF (LESTEF(1).EQ.'LINE')THEN
  1753. NEFMOD=0
  1754. IF (ITYP1.EQ. 3) NEFMOD=129
  1755. IF (ITYP1.EQ. 7) NEFMOD=130
  1756. IF (ITYP1.EQ.11) NEFMOD=131
  1757. IF (ITYP1.EQ.33) NEFMOD=132
  1758. IF (ITYP1.EQ.34) NEFMOD=133
  1759. IF (ITYP1.EQ.35) NEFMOD=134
  1760. IF (ITYP1.EQ.36) NEFMOD=135
  1761. IF (NEFMOD.EQ.0) GOTO 99
  1762. ELSE IF(LESTEF(1).EQ.'MACR')THEN
  1763. NEFMOD=0
  1764. IF (ITYP1.EQ. 3) NEFMOD=136
  1765. IF (ITYP1.EQ. 7) NEFMOD=137
  1766. IF (ITYP1.EQ.11) NEFMOD=138
  1767. IF (ITYP1.EQ.33) NEFMOD=139
  1768. IF (ITYP1.EQ.34) NEFMOD=140
  1769. IF (ITYP1.EQ.35) NEFMOD=141
  1770. IF (ITYP1.EQ.36) NEFMOD=142
  1771. C Il nous manque la pyramide
  1772. IF (NEFMOD.EQ.0) GOTO 99
  1773. ELSE IF (LESTEF(1).EQ.'QUAF') THEN
  1774. NEFMOD=0
  1775. IF (ITYP1.EQ. 3) NEFMOD=143
  1776. IF (ITYP1.EQ. 7) NEFMOD=144
  1777. IF (ITYP1.EQ.11) NEFMOD=145
  1778. IF (ITYP1.EQ.33) NEFMOD=146
  1779. IF (ITYP1.EQ.34) NEFMOD=147
  1780. IF (ITYP1.EQ.35) NEFMOD=148
  1781. IF (ITYP1.EQ.36) NEFMOD=149
  1782. C Il nous manque la pyramide
  1783. IF (NEFMOD.EQ.0) GO TO 99
  1784. ELSE IF (LESTEF(1).EQ.'LINB') THEN
  1785. NEFMOD=0
  1786. IF (ITYP1.EQ. 3) NEFMOD=158
  1787. IF (ITYP1.EQ. 7) NEFMOD=159
  1788. IF (ITYP1.EQ.11) NEFMOD=160
  1789. IF (ITYP1.EQ.33) NEFMOD=161
  1790. IF (ITYP1.EQ.34) NEFMOD=162
  1791. C IF (ITYP1.EQ.35) NEFMOD=163
  1792. C IF (ITYP1.EQ.36) NEFMOD=164
  1793. C Il nous manque la pyramide et le tetrahedre
  1794. IF (NEFMOD.EQ.0) GOTO 99
  1795. ELSE
  1796. DO i=1,ITEF
  1797. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1798. IF (MELE.EQ.0) GOTO 99
  1799. MEGE=NUMGEO(MELE)
  1800. IF (MEGE.EQ.0) GOTO 99
  1801. IF (MEGE.EQ.ITYP1) GOTO 610
  1802. ENDDO
  1803. GO TO 99
  1804. 610 NEFMOD=MELE
  1805. ENDIF
  1806. C Cas de la FORMULATION 'EULER'
  1807. ELSE IF (LESFOR(1).EQ.'EULER') THEN
  1808. NEFMOD=0
  1809. IF (ITYP1.EQ. 2) NEFMOD=ITYP1
  1810. IF (ITYP1.EQ. 4) NEFMOD=ITYP1
  1811. IF (ITYP1.EQ. 8) NEFMOD=ITYP1
  1812. IF (ITYP1.EQ.14) NEFMOD=ITYP1
  1813. IF (ITYP1.EQ.16) NEFMOD=ITYP1
  1814. IF (ITYP1.EQ.23) NEFMOD=ITYP1
  1815. IF (ITYP1.EQ.25) NEFMOD=ITYP1
  1816. IF (NEFMOD.EQ.0) GOTO 99
  1817. C Cas des autres FORMULATIONs
  1818. ELSE
  1819. DO i=1,ITEF
  1820. if(lestef(i)(1:4).eq.'BBAR') lobbar = .true.
  1821. if (lobbar) CALL MODE20(ITYP1,LESTEF(I))
  1822. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1823. IF (MELE.EQ.0) GOTO 99
  1824. MEGE=NUMGEO(MELE)
  1825. IF (MEGE.EQ.0) GOTO 99
  1826. IF (MEGE.EQ.ITYP1) GOTO 6
  1827. c kich cas du POI1
  1828. if (ityp1.eq.1) goto 6
  1829. ENDDO
  1830. GOTO 99
  1831. C Cas particulier pour les elements polygonaux
  1832. 6 IF (ITYP1.EQ.32) THEN
  1833. MELE=MELE+NBNN-3
  1834. IF (NBNN.GT.14) GOTO 99
  1835. ENDIF
  1836. NEFMOD=MELE
  1837. ENDIF
  1838. C Affectation des elements finis de maniere automatique
  1839. ELSE
  1840. C Cas des milieux POREUX
  1841. IF (LESFOR(1).EQ.'POREUX') THEN
  1842. NEFMOD=0
  1843. IF (ITYP1.EQ. 6) NEFMOD=79
  1844. IF (ITYP1.EQ.10) NEFMOD=80
  1845. IF (ITYP1.EQ.15) NEFMOD=81
  1846. IF (ITYP1.EQ.24) NEFMOD=82
  1847. IF (ITYP1.EQ.17) NEFMOD=83
  1848. IF (ITYP1.EQ.29) NEFMOD=108
  1849. IF (ITYP1.EQ.30) NEFMOD=109
  1850. IF (ITYP1.EQ.31) NEFMOD=110
  1851. IF (NEFMOD.EQ.0) GOTO 99
  1852. C Cas des elements de frottement (formulation FROTTEMENT)
  1853. ELSE IF (LESFOR(1).EQ.'CONTACT') THEN
  1854. C * NEFMOD=22 pv est passe par la
  1855. NEFMOD=0
  1856. if(ifrtt.eq.1) then
  1857. IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=107
  1858. IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=165
  1859. elseif(ifroca.ne.0) then
  1860. IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=261
  1861. IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=262
  1862. endif
  1863. C IF (NEFMOD.EQ.0) GOTO 99
  1864. C Cas des elements hybrides (imposes en DARCY)
  1865. ELSE IF (LESFOR(1).EQ.'DARCY') THEN
  1866. NEFMOD=0
  1867. IF (ITYP1.EQ. 3) NEFMOD=143
  1868. C IF (ITYP1.EQ. 4) NEFMOD=99
  1869. C IF (ITYP1.EQ. 8) NEFMOD=100
  1870. C IF (ITYP1.EQ.23) NEFMOD=101
  1871. C IF (ITYP1.EQ.16) NEFMOD=102
  1872. C IF (ITYP1.EQ.14) NEFMOD=103
  1873. IF (ITYP1.EQ. 7) NEFMOD=99
  1874. IF (ITYP1.EQ.11) NEFMOD=100
  1875. IF (ITYP1.EQ.35) NEFMOD=101
  1876. IF (ITYP1.EQ.34) NEFMOD=102
  1877. IF (ITYP1.EQ.33) NEFMOD=103
  1878. IF (NEFMOD.EQ.0) GOTO 99
  1879. C Cas de la formulation MAGNETODYNAMIQUE
  1880. ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  1881. NEFMOD=0
  1882. IF (ITYP1.EQ. 4) NEFMOD=128
  1883. IF (NEFMOD.EQ.0) GOTO 99
  1884. C Cas de la formulation 'NAVIER_STOKES'
  1885. ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN
  1886. IF (ILNAVI.EQ.0) THEN
  1887. CALL MESLIR(-341)
  1888. GOTO 990
  1889. ELSEIF (ILNAVI.EQ.1) THEN
  1890. C LICE
  1891. NEFMOD=0
  1892. IF (ITYP1.EQ. 3) NEFMOD=195
  1893. IF (ITYP1.EQ. 7) NEFMOD=196
  1894. IF (ITYP1.EQ.11) NEFMOD=197
  1895. IF (ITYP1.EQ.33) NEFMOD=198
  1896. IF (ITYP1.EQ.34) NEFMOD=199
  1897. IF (ITYP1.EQ.35) NEFMOD=200
  1898. IF (ITYP1.EQ.36) NEFMOD=201
  1899. IF (NEFMOD.EQ.0) GOTO 99
  1900. ELSEIF (ILNAVI.EQ.2) THEN
  1901. C LIMS
  1902. NEFMOD=0
  1903. IF (ITYP1.EQ. 3) NEFMOD=202
  1904. IF (ITYP1.EQ. 7) NEFMOD=203
  1905. IF (ITYP1.EQ.11) NEFMOD=204
  1906. IF (ITYP1.EQ.33) NEFMOD=205
  1907. IF (ITYP1.EQ.34) NEFMOD=206
  1908. IF (ITYP1.EQ.35) NEFMOD=207
  1909. IF (ITYP1.EQ.36) NEFMOD=208
  1910. IF (NEFMOD.EQ.0) GOTO 99
  1911. ELSEIF (ILNAVI.EQ.3) THEN
  1912. C LBMS
  1913. NEFMOD=0
  1914. IF (ITYP1.EQ. 3) NEFMOD=209
  1915. IF (ITYP1.EQ. 7) NEFMOD=210
  1916. IF (ITYP1.EQ.11) NEFMOD=211
  1917. IF (ITYP1.EQ.33) NEFMOD=212
  1918. IF (ITYP1.EQ.34) NEFMOD=213
  1919. IF (ITYP1.EQ.35) NEFMOD=214
  1920. IF (ITYP1.EQ.36) NEFMOD=215
  1921. IF (NEFMOD.EQ.0) GOTO 99
  1922. ELSEIF (ILNAVI.EQ.4) THEN
  1923. C MCCE
  1924. NEFMOD=0
  1925. IF (ITYP1.EQ. 3) NEFMOD=216
  1926. IF (ITYP1.EQ. 7) NEFMOD=217
  1927. IF (ITYP1.EQ.11) NEFMOD=218
  1928. IF (ITYP1.EQ.33) NEFMOD=219
  1929. IF (ITYP1.EQ.34) NEFMOD=220
  1930. IF (ITYP1.EQ.35) NEFMOD=221
  1931. IF (ITYP1.EQ.36) NEFMOD=222
  1932. IF (NEFMOD.EQ.0) GOTO 99
  1933. ELSEIF (ILNAVI.EQ.5) THEN
  1934. C MCP1
  1935. NEFMOD=0
  1936. IF (ITYP1.EQ. 3) NEFMOD=223
  1937. IF (ITYP1.EQ. 7) NEFMOD=224
  1938. IF (ITYP1.EQ.11) NEFMOD=225
  1939. IF (ITYP1.EQ.33) NEFMOD=226
  1940. IF (ITYP1.EQ.34) NEFMOD=227
  1941. IF (ITYP1.EQ.35) NEFMOD=228
  1942. IF (ITYP1.EQ.36) NEFMOD=229
  1943. IF (NEFMOD.EQ.0) GOTO 99
  1944. ELSEIF (ILNAVI.EQ.6) THEN
  1945. C MCMS
  1946. NEFMOD=0
  1947. IF (ITYP1.EQ. 3) NEFMOD=230
  1948. IF (ITYP1.EQ. 7) NEFMOD=231
  1949. IF (ITYP1.EQ.11) NEFMOD=232
  1950. IF (ITYP1.EQ.33) NEFMOD=233
  1951. IF (ITYP1.EQ.34) NEFMOD=234
  1952. IF (ITYP1.EQ.35) NEFMOD=235
  1953. IF (ITYP1.EQ.36) NEFMOD=236
  1954. IF (NEFMOD.EQ.0) GOTO 99
  1955. ELSEIF (ILNAVI.EQ.7) THEN
  1956. C QFCE
  1957. NEFMOD=0
  1958. IF (ITYP1.EQ. 3) NEFMOD=237
  1959. IF (ITYP1.EQ. 7) NEFMOD=238
  1960. IF (ITYP1.EQ.11) NEFMOD=239
  1961. IF (ITYP1.EQ.33) NEFMOD=240
  1962. IF (ITYP1.EQ.34) NEFMOD=241
  1963. IF (ITYP1.EQ.35) NEFMOD=242
  1964. IF (ITYP1.EQ.36) NEFMOD=243
  1965. IF (NEFMOD.EQ.0) GOTO 99
  1966. ELSEIF (ILNAVI.EQ.8) THEN
  1967. C QFP1
  1968. NEFMOD=0
  1969. IF (ITYP1.EQ. 3) NEFMOD=244
  1970. IF (ITYP1.EQ. 7) NEFMOD=245
  1971. IF (ITYP1.EQ.11) NEFMOD=246
  1972. IF (ITYP1.EQ.33) NEFMOD=247
  1973. IF (ITYP1.EQ.34) NEFMOD=248
  1974. IF (ITYP1.EQ.35) NEFMOD=249
  1975. IF (ITYP1.EQ.36) NEFMOD=250
  1976. IF (NEFMOD.EQ.0) GOTO 99
  1977. ELSEIF (ILNAVI.EQ.9) THEN
  1978. C QFMS
  1979. NEFMOD=0
  1980. IF (ITYP1.EQ. 3) NEFMOD=251
  1981. IF (ITYP1.EQ. 7) NEFMOD=252
  1982. IF (ITYP1.EQ.11) NEFMOD=253
  1983. IF (ITYP1.EQ.33) NEFMOD=254
  1984. IF (ITYP1.EQ.34) NEFMOD=255
  1985. IF (ITYP1.EQ.35) NEFMOD=256
  1986. IF (ITYP1.EQ.36) NEFMOD=257
  1987. IF (NEFMOD.EQ.0) GOTO 99
  1988. ENDIF
  1989. C Cas de la formulation 'EULER'
  1990. ELSE IF (LESFOR(1).EQ.'EULER') THEN
  1991. NEFMOD=0
  1992. IF (ITYP1.EQ. 2) NEFMOD=ITYP1
  1993. IF (ITYP1.EQ. 4) NEFMOD=ITYP1
  1994. IF (ITYP1.EQ. 8) NEFMOD=ITYP1
  1995. IF (ITYP1.EQ.14) NEFMOD=ITYP1
  1996. IF (ITYP1.EQ.16) NEFMOD=ITYP1
  1997. IF (ITYP1.EQ.23) NEFMOD=ITYP1
  1998. IF (ITYP1.EQ.25) NEFMOD=ITYP1
  1999. IF (NEFMOD.EQ.0) GOTO 99
  2000. C Cas des autres formulations
  2001. ELSE
  2002. NEFMOD=ITYP1
  2003. c kich cas du POI1
  2004. if (ityp1.eq.1) nefmod = 45
  2005. C Cas particuliers des elements polygonaux
  2006. IF (NEFMOD.EQ.32) NEFMOD=111+NBNN -3
  2007. C Cas particuliers des elements finis pour IDIM=1
  2008. IF (IDIM.EQ.1) THEN
  2009. NEFMOD=0
  2010. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  2011. IF (ICONV.NE.0 .OR. iraye.NE.0) THEN
  2012. IF (ITYP1.EQ.1) NEFMOD=45
  2013. IF (ITYP1.EQ.2) NEFMOD=ITYP1
  2014. ELSE
  2015. IF (ITYP1.EQ.2) NEFMOD=191
  2016. IF (ITYP1.EQ.3) NEFMOD=192
  2017. ENDIF
  2018. ELSE IF (LESFOR(1).EQ.'MECANIQUE') THEN
  2019. IF (ITYP1.EQ.2) NEFMOD=193
  2020. IF (ITYP1.EQ.3) NEFMOD=194
  2021. ELSE IF (LESFOR(1).EQ.'FISSURE') THEN
  2022. IF (ITYP1.EQ.2) NEFMOD=ITYP1
  2023. ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN
  2024. IF (ITYP1.EQ.2) NEFMOD=193
  2025. IF (ITYP1.EQ.3) NEFMOD=194
  2026. ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN
  2027. * En attendant le retour a la normale pour la diffusion, on ajoute une
  2028. * enieme rustine en mettant les memes elements qu'en thermique.
  2029. ** IF (ITYP1.EQ.2) NEFMOD=193
  2030. ** IF (ITYP1.EQ.3) NEFMOD=194
  2031. IF (ITYP1.EQ.2) NEFMOD=191
  2032. IF (ITYP1.EQ.3) NEFMOD=192
  2033. ENDIF
  2034. ENDIF
  2035. IF (NEFMOD.EQ.0) GOTO 99
  2036. MELE=NEFMOD
  2037. ENDIF
  2038. ENDIF
  2039. C +--------------------------------------------------------------------+
  2040. C | Fin de la valeur de NEFMOD pour IMODEL |
  2041. C +--------------------------------------------------------------------+
  2042.  
  2043. C Poursuite du remplissage du IM-eme modele elementaire IMODEL
  2044. IF (NMAT.NE.0) THEN
  2045. IF (LESFOR(1).EQ.'MELANGE') THEN
  2046. MATMOD(1)=LESPRO(1)
  2047. ELSE
  2048. DO i=1,NMAT
  2049. MATMOD(i)=LESPRO(i)
  2050. ENDDO
  2051. ENDIF
  2052. ENDIF
  2053.  
  2054. 11 CONTINUE
  2055. DO i=1,NFOR
  2056. FORMOD(i)=LESFOR(i)
  2057. ENDDO
  2058. IF (MN3.NE.0) INFMOD(1)=NPINT
  2059. C (fdp) Pour les elements JOI1 seulement, on stocke -1*ILIE dans
  2060. C INFMOD(9) (il semble que INFMOD(8) soit utilise par-ci par-la)
  2061. IF (ILIE.NE.0) THEN
  2062. IF (NEFMOD.NE.265) THEN
  2063. CALL ERREUR(19)
  2064. GOTO 990
  2065. ENDIF
  2066. INFMOD(9)=-1*ILIE
  2067. ENDIF
  2068. * AM cas non-local
  2069. IF(INLOC.NE.0) THEN
  2070. INFMOD(13)=-1*INLOC
  2071. INFMOD(14)=LULVIA
  2072. ENDIF
  2073. IF (NPINT.NE.0.AND.NEFMOD.NE.28) THEN
  2074. CALL ERREUR(608)
  2075. GOTO 990
  2076. ENDIF
  2077. C Verification de l'existence du MMODEL
  2078. IF(ITYP1.NE.48) THEN
  2079. c write(6,*) 'MATMOD =',(matmod(i),i=1,nmat)
  2080. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU)
  2081. IF(IERR .NE. 0) RETURN
  2082. IF (CMATE .EQ. ' ') THEN
  2083. write(ioimp,*) ' petit probleme apres nomate'
  2084. CALL ERREUR(251)
  2085. GOTO 990
  2086. ENDIF
  2087. ENDIF
  2088.  
  2089.  
  2090. C* Petit cas particulier en cas de modele VISCO_EXTERNE :
  2091. C* On recupere IVIEX stocke dans INATU (cf. NOMATE)
  2092. IF (INATU .LE. -2) THEN
  2093. IVIEX = -2 -INATU
  2094. INATU = -2
  2095. C* TYMODE(LMEIVI)='IVIEX '
  2096. IVAMOD(LMEIVI)= IVIEX
  2097. ENDIF
  2098. C
  2099. ideriv=jderiv
  2100. CMATEE=CMATE
  2101. IMATEE=IMATE
  2102. INATUU=INATU
  2103.  
  2104. C +--------------------------------------------------------------------+
  2105. C | initialisation des nomid (NOMS des composantes) |
  2106. C +--------------------------------------------------------------------+
  2107. C linomid=false quand on ne veut pas aller dans inomid
  2108. linomid=.true.
  2109. IF (FORMOD(1).NE.'NAVIER_STOKES' .AND.
  2110. & FORMOD(1).NE.'EULER' .AND.
  2111. & FORMOD(1).NE.'MELANGE' ) THEN
  2112.  
  2113. if (formod(1).EQ.'LIAISON') then
  2114. linomid=.false.
  2115. else
  2116. do jn = 1,matmod(/2)
  2117. if (matmod(jn).eq.'MODAL' .or.
  2118. & matmod(jn).eq.'STATIQUE' .or.
  2119. & matmod(jn).eq.'IMPEDANCE' ) linomid =.false.
  2120. enddo
  2121. endif
  2122.  
  2123.  
  2124.  
  2125. if(ITYP1.EQ.48) then
  2126. C cas particulier des relations de conformite
  2127. c pour les SURE
  2128. c on recupere les noms de composantes 'DEPLACEM' et 'FORCES'
  2129. c des éléments parents (NEPAPA => QUA4 ou CUB8)
  2130. segini,IMODE5=IMODEL
  2131. IMODE5.NEFMOD=NEPAPA
  2132. call inomid(IMODE5,' ',iret,lucvar,lucmat,
  2133. & lucmaf,luparx)
  2134. LNOMID(1)=IMODE5.LNOMID(1)
  2135. LNOMID(2)=IMODE5.LNOMID(2)
  2136. segsup,IMODE5
  2137. NOMID=LNOMID(1)
  2138. SEGACT,NOMID
  2139. NOMID=LNOMID(2)
  2140. SEGACT,NOMID
  2141. else
  2142. if (linomid) call inomid(imodel,' ',
  2143. & iret,lucvar,lucmat,lucmaf,luparx)
  2144. endif
  2145.  
  2146. ELSE
  2147. linomid=.true.
  2148. ENDIF
  2149.  
  2150. C Quelques tests supplementaires en attendant mieux
  2151. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  2152. C nnz = MATMOD(/2)
  2153. iplaz = 0
  2154. call place(MATMOD,MATMOD(/2),iplaz,'PHASE')
  2155. IF (iplaz.ne.0 ) THEN
  2156. c test que les elements sont lineaires
  2157. ipt4 = imamod
  2158. segact ipt4
  2159. itt = ipt4.itypel
  2160. if (kdegre(itt) .gt. 2) then
  2161. call erreur(982)
  2162. goto 990
  2163. endif
  2164. ENDIF
  2165. endif
  2166.  
  2167. IF (LESFOR(1).EQ.'MECANIQUE') THEN
  2168. C Cas du materiau unidirectionnel
  2169. IF (IMATE.EQ.4) THEN
  2170. MFR=NUMMFR(NEFMOD)
  2171. C Cas des cerces : sans interet !
  2172. IF (MFR.EQ.27) THEN
  2173. CALL ERREUR(251)
  2174. GOTO 990
  2175. ENDIF
  2176. C Cas de la plasticite
  2177. IF (INATU.NE.0) THEN
  2178. C OK si massif bidim ou si coque tridim dans le cas acier_uni
  2179. IF (INATU.EQ.40)THEN
  2180. IF ((MFR.NE.1.OR.IFOUR.GT.0).AND.
  2181. . ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN
  2182. CALL ERREUR(251)
  2183. GOTO 990
  2184. ENDIF
  2185. C Dans les autres cas, on n'autorise pour le moment que COQ2 et massif
  2186. ELSE IF (MELE.NE.44.AND.MFR.NE.1) THEN
  2187. CALL ERREUR(251)
  2188. GOTO 990
  2189. ENDIF
  2190. ENDIF
  2191. ENDIF
  2192. C
  2193. C Cas du materiau 'ZONE_COHESIVE'
  2194. IF (IMATE.EQ.12) THEN
  2195. MFR=NUMMFR(NEFMOD)
  2196. IF (MFR.NE.77) THEN
  2197. CALL ERREUR(251)
  2198. GOTO 990
  2199. ENDIF
  2200. ENDIF
  2201.  
  2202. C Cas du modele section : on n'autorise pour le moment que TIMO
  2203. IF (CMATE.EQ.'SECTION'.AND.MELE.NE.84) THEN
  2204. CALL ERREUR(251)
  2205. GOTO 990
  2206. ENDIF
  2207. ENDIF
  2208. C Le modele de GURSON n'est possible qu'en 3D, axisymetrique ou
  2209. C deformations planes
  2210. IF (INATU.EQ.38) THEN
  2211. IF ( (IFOUR.NE.0).AND.(IFOUR.NE.2).AND.(IFOUR.NE.-1) ) THEN
  2212. MOTERR(1:8)='GURSON'
  2213. MOTERR(9:16)='MECANIQU'
  2214. INTERR(1) = IFOUR
  2215. CALL ERREUR (81)
  2216. GOTO 990
  2217. ENDIF
  2218. ENDIF
  2219.  
  2220. C Le modele ISS_GRANGE n'est utilisable qu'en 3D
  2221. IF ((INATU.EQ.151).AND.(IFOUR.NE.2)) THEN
  2222. INTERR(1) = IFOUR
  2223. CALL ERREUR (709)
  2224. GOTO 990
  2225. ENDIF
  2226. C Le modele RUP_THER n'est utilisable qu'en 3D
  2227. IF ((INATU.EQ.152).AND.(IFOUR.NE.2)) THEN
  2228. INTERR(1) = IFOUR
  2229. CALL ERREUR (709)
  2230. GOTO 990
  2231. ENDIF
  2232. C Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1
  2233. IF ((INATU.EQ.34).AND.(IFOUR.NE.2)
  2234. . .AND.(NUMMFR(NEFMOD).EQ.75)) THEN
  2235. INTERR(1) = IFOUR
  2236. CALL ERREUR (709)
  2237. GOTO 990
  2238. ENDIF
  2239. C.. Restrictions en formulation 'MECANIQUE' avec une loi de
  2240. C comportement non lineaire externe
  2241. C Rappel : LMEEXT exprime la condition (NFOR.EQ.1) ET
  2242. C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
  2243. IF ( LMEEXT ) THEN
  2244. C En formulation 'MECANIQUE', les lois non lineaires externes
  2245. C n'autorisent qu'une seule composante de temperature
  2246. C => incompatibilite avec des modeles de coques n'ayant pas
  2247. C de points d'integration dans l'epaisseur (trois composantes
  2248. C dans ce cas, 'TINF', 'T ' et 'TSUP')
  2249. C Le test ci-dessous est coherent avec celui de IDTEMP.
  2250. MFR = NUMMFR(NEFMOD)
  2251. IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND.
  2252. . (NPINT.EQ.0) ) THEN
  2253. CALL ERREUR(951)
  2254. GOTO 990
  2255. ENDIF
  2256. C Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour
  2257. C l'instant qu'aux elements massifs, avec option de calcul 3D
  2258. C Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL'
  2259. IF ( LMEVIX ) THEN
  2260. IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN
  2261. KERRE = 950
  2262. ELSE IF ( IVIEX.NE.1 ) THEN
  2263. KERRE = 958
  2264. ELSE
  2265. KERRE = 0
  2266. ENDIF
  2267. IF (KERRE.NE.0) THEN
  2268. CALL ERREUR(KERRE)
  2269. GOTO 990
  2270. ENDIF
  2271. ENDIF
  2272. ENDIF
  2273.  
  2274. C Formulation 'THERMIQUE' 'CONVECTION'
  2275. C Adequation EF de type COQue et mot 'INFERIEURE' / 'SUPERIEURE'
  2276. IF (ICONV.EQ.1) THEN
  2277. CALL PLACE(LESPRO,NMAT,ISUP,'SUPERIEURE')
  2278. CALL PLACE(LESPRO,NMAT,IINF,'INFERIEURE')
  2279. ITOT = ISUP+IINF
  2280. IF (ITOT.NE.0.AND.NEFMOD.NE.27.AND.NEFMOD.NE.41.AND.
  2281. . NEFMOD.NE.44.AND.NEFMOD.NE.49.AND.NEFMOD.NE.56) THEN
  2282. CALL ERREUR(16)
  2283. GOTO 990
  2284. ENDIF
  2285. IF (ITOT.EQ.0.AND.(NEFMOD.EQ.27.OR.NEFMOD.EQ.41.OR.
  2286. . NEFMOD.EQ.44.OR.NEFMOD.EQ.49.OR.NEFMOD.EQ.56)) THEN
  2287. CALL ERREUR(513)
  2288. GOTO 990
  2289. ENDIF
  2290. ENDIF
  2291.  
  2292. C Formulation 'DIFFUSION' :
  2293. IF (LESFOR(1) .EQ. 'DIFFUSION') THEN
  2294. C - Verification sur les types de FORMULATION et/ou d'elements
  2295. MFR1 = NUMMFR(nefmod)
  2296. IF ((IFOUR.EQ.2 .AND. NEFMOD.GE.4 .AND. NEFMOD.LT.11) .OR.
  2297. & (MFR1.NE.1 .AND. MFR1.NE.3 .AND. MFR1.NE.5 .AND.
  2298. & MFR1.NE.7 .AND. MFR1.NE.9 .AND. MFR1.NE.73.AND.
  2299. & MFR1.NE.27)) THEN
  2300. CALL ERREUR(16)
  2301. GOTO 99
  2302. ENDIF
  2303.  
  2304. C - Modele UTILISATEUR :
  2305. C Verification que les composantes "lineaires" sont declarees
  2306. IF (LDIEXT) THEN
  2307. CALL IDDILI(IMATE,0, MOCOMP,NBROBL,NBRFAC)
  2308. MLMOTS = MOCOMP
  2309. MLMOT1 = lucmat
  2310. SEGACT,MLMOT1
  2311. NBCOMP = MLMOT1.MOTS(/2)
  2312. ICOMP = 0
  2313. DO i = 1, NBROBL
  2314. CALL PLACE(MLMOT1.MOTS,NBCOMP,IPLAC,MOTS(i))
  2315. IF (IPLAC.EQ.0) THEN
  2316. WRITE(IOIMP,80) MOTS(i)
  2317. 80 FORMAT('La composante obligatoire ',A8,' est absente')
  2318. ELSE
  2319. ICOMP = ICOMP+1
  2320. ENDIF
  2321. ENDDO
  2322. SEGSUP,MLMOTS
  2323. IF (ICOMP.NE.NBROBL) THEN
  2324. GOTO 99
  2325. ENDIF
  2326. ENDIF
  2327. ENDIF
  2328.  
  2329. C Formulation 'ELECTROSTATIQUE' :
  2330. C Petite verification (a priori sans probleme)
  2331. IF (LESFOR(1) .EQ. 'ELECTROSTATIQUE') THEN
  2332. MFR1 = NUMMFR(nefmod)
  2333. IF (MFR1.NE.1) THEN
  2334. CALL ERREUR(21)
  2335. GOTO 99
  2336. ENDIF
  2337. ENDIF
  2338.  
  2339. C kich
  2340. c 11 CONTINUE
  2341. C initialisation du infele et des segment d'integration
  2342. IF (LESFOR(1).EQ.'MECANIQUE' .OR. LESFOR(1).EQ.'POREUX' .OR.
  2343. $ LESFOR(1).EQ.'LIQUIDE' .OR. LESFOR(1).EQ.'DIFFUSION' .OR.
  2344. $ LESFOR(1).EQ.'ELECTROSTATIQUE' .OR.
  2345. $ LESFOR(1).EQ.'CHARGEMENT' .OR.
  2346. $ NFOR.EQ.2 ) THEN
  2347. infele(2)=npint
  2348. infele(3)=ngmas
  2349. infele(4)=ngcon
  2350. infele(6)=ngrig
  2351. call prquoi (imodel)
  2352. endif
  2353.  
  2354. C initialisation des nomid (cas particuliers)
  2355. if (.not. linomid) then
  2356. if (irmot1.eq.1) then
  2357. mlmot5 = jlmot1
  2358. mlmot6 = jlmot2
  2359. segact mlmot5,mlmot6
  2360. if (mlmot5.mots(/2).ne.mlmot6.mots(/2)) call erreur(26)
  2361. lucvar = jlmot1
  2362. lucmat = jlmot2
  2363. nobmod = 2
  2364. segadj imodel
  2365. ivamod(1) = jlmot1
  2366. ivamod(2) = jlmot2
  2367. tymode(1) = 'LISTMOTS'
  2368. tymode(2) = 'LISTMOTS'
  2369. endif
  2370. call prquoi (imodel)
  2371. call inomid(imodel,' ',iret,lucvar,lucmat,
  2372. & lucmaf,luparx)
  2373. endif
  2374.  
  2375. mfr2 = 0
  2376. IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.
  2377. & FORMOD(1).NE.'EULER' .AND.
  2378. & FORMOD(1).NE.'CHARGEMENT' ) THEN
  2379. C kich : Verification de non redondance des nom des composantes
  2380. C sauf pour les formulations Navier_Stokes, Euler et CHARGEMENT
  2381. ipmo = imodel
  2382. mfr1 = NUMMFR(nefmod)
  2383. mfr2 = infele(13)
  2384. segact,imodel*mod
  2385. CALL cotemo(ipmo,mfr2)
  2386. IF (IERR.NE.0) RETURN
  2387. ENDIF
  2388.  
  2389. C IF (IM.EQ.1) MFRTMP=mfr1
  2390.  
  2391. C Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14)
  2392. C Ce point n'est pris en compte que si cela est necessaire
  2393. MFR3=MFR2
  2394. IF (FORMOD(1).EQ.'CHARGEMENT') MFR3=INFELE(13)
  2395. CALL INFDPG(mfr3,IFOUR, LOGRE,ndpge)
  2396. IF (LOGRE) THEN
  2397. C Erreur si ce point support n'est pas fourni avec le mot-cle GENE.
  2398. IF (IPTGEN.EQ.0) THEN
  2399. CALL ERREUR(925)
  2400. RETURN
  2401. ENDIF
  2402. imodel.IPDPGE = IPTGEN
  2403. ELSE
  2404. IF (IPTGEN.NE.0) THEN
  2405. write(ioimp,*) 'Mot-cle GENE + Point ignores...'
  2406. ENDIF
  2407. imodel.IPDPGE = 0
  2408. ENDIF
  2409.  
  2410. C Test CLEMENT entre INFELE(16) et la dimension du NOMID des DEFORMATIONS
  2411. C ATTENTION (celui des CONTRAINTES peut contenir une info en plus sur les MODES en fourier...)
  2412. NOMID=LNOMID(5)
  2413. IF(NOMID .GT. 0)THEN
  2414. SEGACT,NOMID
  2415. NOBLST=NOMID.LESOBL(/2)
  2416. NFACST=NOMID.LESFAC(/2)
  2417. INFELE(16)=NOBLST+NFACST
  2418. ELSE
  2419. INFELE(16)=0
  2420. ENDIF
  2421.  
  2422. SEGACT,IMODEL*NOMOD
  2423. 10 CONTINUE
  2424. C ****************************************************
  2425. C fin de boucle sur les sous-parties du maillages
  2426. C *************************************************
  2427.  
  2428. DO 68 K=1,MMODEL.KMODEL(/1)
  2429. IMODE5=MMODEL.KMODEL(K)
  2430. SEGACT IMODE5
  2431. IF (IMODE5.NEFMOD.NE.22 ) GOTO 68
  2432. IPT3=IMODE5.IMAMOD
  2433. SEGACT IPT3
  2434. 68 CONTINUE
  2435. IPMODE=MMODEL
  2436. C construction modeles elementaires pour MELANGE cccccccccccccc
  2437. C une loi de melange pointe sur des modeles
  2438. C elementaires de meme support
  2439. lomela = .true.
  2440. IF (LESFOR(1).eq.'MELANGE') THEN
  2441. segini limode
  2442. do 500 ilm = 1,NMAT1
  2443. IF (LESMOD(ilm).GT.0) THEN
  2444. n1 = nsou1
  2445. segini mmode2
  2446. WRITE(CONM,FMT='(I16)') mmode2
  2447. segsup mmode2
  2448. do 511 im = 1,nsou1
  2449. imodel = kmodel(im)
  2450. IF (ilm.eq.1) THEN
  2451. segact imodel*mod
  2452. nmat = 1
  2453. mn3 = infmod(/1)
  2454. nfor = 1
  2455. nobmod = ivamod(/1)
  2456. segadj imodel
  2457. ELSE
  2458. segact imodel
  2459. MN3 = infmod(/1)
  2460. NFOR = 1
  2461. NMAT = 1
  2462. NOBMOD = 0
  2463. segini imode2
  2464. imode2.imamod = imamod
  2465. imode2.nefmod = nefmod
  2466. if (mn3.gt.0) then
  2467. do imm = 1,mn3
  2468. imode2.infmod(imm) = infmod(imm)
  2469. enddo
  2470. endif
  2471. imode2.formod(1) = 'MELANGE'
  2472. imode2.IPDPGE = IPDPGE
  2473. imode2.conmod = conm
  2474. imode2.conmod(17:24) = pham
  2475. imodel = imode2
  2476. limode(**) = imodel
  2477. matmod(1) = lespro(ilm)
  2478. ENDIF
  2479. c lmomat = 0
  2480. c lmovar = 0
  2481. MMODE1 = LESMOD(ilm)
  2482. SEGACT MMODE1
  2483. kbmod = ivamod(/1)
  2484. nobmod = kbmod + MMODE1.KMODEL(/1)
  2485. segadj imodel
  2486. DO 515 im1 = 1,MMODE1.KMODEL(/1)
  2487. imode1 = mmode1.kmodel(im1)
  2488. segact imode1
  2489. mfo1 = imode1.formod(/2)
  2490. mma1 = imode1.matmod(/2)
  2491. if (imode1.conmod(17:24).eq.' ') then
  2492. write(ioimp,*) 'pas de nom de phase pour MELANGE '
  2493. lomela = .false.
  2494. endif
  2495. IF (imodel.imamod.eq.imode1.imamod) THEN
  2496. C quelques verifs
  2497. if (matmod(1).eq.'SERIE'.and.im1.gt.1) then
  2498. do im2 = 1,MMODE1.KMODEL(/1)
  2499. imode2 = mmode1.kmodel(im2)
  2500. segact imode2
  2501. mfo2 = imode2.formod(/2)
  2502. mma2 = imode2.matmod(/2)
  2503. if (mfo1.eq.mfo2.and.imode1.formod(mfo1).eq.imode2.formod(mfo2))
  2504. & then
  2505. C * pas de phase identique dans la meme fomulation
  2506. C * if (imode1.conmod(17:24).eq.imode2.conmod(17:24)) lomela =.false.
  2507. if (mma1.ne.mma2.OR.
  2508. & imode1.matmod(mma1).ne.imode2.matmod(mma2)) lomela = .false.
  2509.  
  2510. endif
  2511. enddo
  2512. endif
  2513. IF (.NOT.lomela) THEN
  2514. C *** detruire
  2515. C 509 CONTINUE
  2516. call erreur(251)
  2517. goto 990
  2518. ENDIF
  2519. C ***
  2520. kbmod = kbmod + 1
  2521. tymode(kbmod) = 'IMODEL'
  2522. ivamod(kbmod) = imode1
  2523. ENDIF
  2524. 515 CONTINUE
  2525.  
  2526. nobmod = kbmod
  2527. segadj imodel
  2528. MFR = NUMMFR(NEFMOD)
  2529. CALL IDMATR(MFR,IMODEL,IPNOMC,NOBL,NFAC)
  2530. 511 continue
  2531. ELSE
  2532. do im = 1,nsou1
  2533. imodel = kmodel(im)
  2534. segact imodel*mod
  2535. nmat = 1
  2536. segadj imodel
  2537. enddo
  2538. ENDIF
  2539. 500 continue
  2540. n1i = kmodel(/1)
  2541. N1 = kmodel(/1) + limode(/1)
  2542. segadj mmodel
  2543. do 502 is = 1,limode(/1)
  2544. kmodel(n1i + is) = limode(is)
  2545. 502 continue
  2546. segsup limode
  2547. ENDIF
  2548. C fin des lois melanges ccccccccccccccccccccccccccccccccccccccccccccc
  2549. C
  2550. C traitement si en entree des modèles
  2551. 70 CONTINUE
  2552. IF (iremod.gt.0) THEN
  2553. do im = 1,kmodel(/1)
  2554. imodel = kmodel(im)
  2555. segact imodel*mod
  2556. if (CONM.NE.' ') conmod = CONM
  2557. if (PHAM.NE.' ') conmod(17:24) = PHAM
  2558. C Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14)
  2559. mfr2 = infele(13)
  2560. IF (FORMOD(1).EQ.'CHARGEMENT') MFR2=0
  2561. CALL INFDPG(mfr2,IFOUR, LOGRE,ndpge)
  2562. IF (LOGRE) THEN
  2563. C Erreur si le point support n'est pas fourni avec le mot-cle GENE.
  2564. IF (IPTGEN.EQ.0) THEN
  2565. CALL ERREUR(925)
  2566. RETURN
  2567. ENDIF
  2568. imodel.IPDPGE = IPTGEN
  2569. ELSE
  2570. C* IF (IPTGEN.NE.0) THEN
  2571. C* write(ioimp,*) 'Mot-cle GENE + Point ignores...'
  2572. C* ENDIF
  2573. imodel.IPDPGE = 0
  2574. ENDIF
  2575. if (NPINT.GT.0) write(ioimp,*) 'ne change pas le nb pts inte'
  2576. enddo
  2577. ENDIF
  2578. C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd
  2579. C cas du mot cle STAT : pointer le modele elementaire approprie
  2580.  
  2581. IF (ipmod1.gt.0) THEN
  2582. MMODE1 = ipmod1
  2583. SEGACT MMODE1
  2584. DO im1 = 1,MMODE1.KMODEL(/1)
  2585. IMODE1 = MMODE1.KMODEL(im1)
  2586. segact imode1
  2587. ENDDO
  2588. DO im = 1,kmodel(/1)
  2589. imodel = kmodel(im)
  2590. segact imodel*mod
  2591. nobmod = ivamod(/1)
  2592. nobmod = nobmod + 1
  2593. nfor = formod(/2)
  2594. nmat = matmod(/2)
  2595. mn3 = infmod(/1)
  2596. segadj imodel
  2597. kbmod = 0
  2598. do im1 = 1,MMODE1.KMODEL(/1)
  2599. imode1 = mmode1.kmodel(im1)
  2600. imomo = imode1
  2601. lostat = .true.
  2602. C criteres de verif assez faibles ...
  2603. if (imode1.nefmod.eq.nefmod.and.
  2604. & imode1.imamod.ne.imamod.and.
  2605. & imode1.matmod(/2).eq.matmod(/2).and.
  2606. & imode1.formod(/2).eq.formod(/2)) then
  2607. do lmo = 1,formod(/2)
  2608. if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false.
  2609. enddo
  2610. do lmo = 1,matmod(/2)
  2611. if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false.
  2612. enddo
  2613. else
  2614. lostat = .false.
  2615. endif
  2616. if (lostat.and.formod(1).eq.'MELANGE') then
  2617. C verifs supplementaires : les modeles de ivamod sont ils bien construi
  2618. lomela = .true.
  2619. if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false.
  2620. if (imode1.ivamod(/1).gt.0) then
  2621. do ivm3 = 1,imode1.ivamod(/1)
  2622. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2623. imode3 = imode1.ivamod(ivm3)
  2624. segact imode3
  2625. ENDIF
  2626. enddo
  2627. endif
  2628. IF (nobmod.gt.1) THEN
  2629. do ivm1 = 1,(nobmod-1)
  2630. imode2 = ivamod(ivm1)
  2631. segact imode2
  2632. cc
  2633. if (imode2.ivamod(/1).ge.1) then
  2634. do ivm2 = 1,imode2.ivamod(/1)
  2635. if (imode2.tymode(ivm2).eq.'STATIO') then
  2636. imode4 = imode2.ivamod(ivm2)
  2637. segact imode4
  2638. if (imode1.ivamod(/1).ge.1) then
  2639. do ivm3 = 1,imode1.ivamod(/1)
  2640. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2641. imode3 = imode1.ivamod(ivm3)
  2642. cc
  2643. lostat = .true.
  2644. C criteres de verif assez faibles ...
  2645. if (imode3.nefmod.eq.imode4.nefmod.and.
  2646. & imode3.imamod.eq.imode4.imamod.and.
  2647. & imode3.matmod(/2).eq.imode4.matmod(/2).and.
  2648. & imode3.conmod(17:24).eq.imode4.conmod(17:24).and.
  2649. & imode3.formod(/2).eq.imode4.formod(/2)) then
  2650. do lmo = 1,imode4.formod(/2)
  2651. if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false.
  2652. enddo
  2653. do lmo = 1,imode4.matmod(/2)
  2654. if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false.
  2655. enddo
  2656. else
  2657. lostat = .false.
  2658. endif
  2659. if (lostat) then
  2660. goto 75
  2661. endif
  2662. cc
  2663. ENDIF
  2664. enddo
  2665. else
  2666. lostat = .false.
  2667. endif
  2668. endif
  2669. enddo
  2670. C
  2671. else
  2672. lomela = .false.
  2673. endif
  2674. 75 lomela = lomela.and.lostat
  2675. enddo
  2676. ENDIF
  2677. lostat = lomela
  2678. do ivm3 = 1,imode1.ivamod(/1)
  2679. c imode1 = imomo
  2680. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2681. imode3 = imode1.ivamod(ivm3)
  2682. ENDIF
  2683. enddo
  2684. endif
  2685. if (lostat) then
  2686. kbmod = kbmod + 1
  2687. tymode(nobmod) = 'STATIO'
  2688. ivamod(nobmod) = imomo
  2689. goto 79
  2690. endif
  2691. enddo
  2692. C *** ca se passe mal
  2693. if (kbmod.ne.1) then
  2694. write(ioimp,*) ' STATIO EN DEFAUT voir notice '
  2695. call erreur(251)
  2696. goto 990
  2697. endif
  2698. C ***
  2699. 79 CONTINUE
  2700. ENDDO
  2701. ENDIF
  2702. C fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd
  2703.  
  2704. C Ecriture de l'objet MODELE cree
  2705. CALL ACTOBJ('MMODEL ',IPMODE,1)
  2706. CALL ECROBJ('MMODEL ',IPMODE)
  2707. RETURN
  2708.  
  2709. C Traitement des ERREURS
  2710. 99 CONTINUE
  2711. CALL ERREUR(21)
  2712. 990 CONTINUE
  2713. DO imu = 1, kmodel(/1)
  2714. imodel = kmodel(imu)
  2715. IF (imodel.NE.0) SEGSUP,imodel
  2716. ENDDO
  2717. SEGSUP,MMODEL
  2718.  
  2719. END
  2720.  
  2721.  
  2722.  
  2723.  
  2724.  

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