Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

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

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