Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

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

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