Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

  1. C MODELI SOURCE KICH 18/01/11 21:15:40 9690
  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. C IF (ITYP1.EQ.35) NEFMOD=141
  1466. C Il nous manque la pyramide
  1467. IF (NEFMOD.EQ.0) GOTO 99
  1468. ELSE IF (LESTEF(1).EQ.'QUAF') THEN
  1469. NEFMOD=0
  1470. IF (ITYP1.EQ. 3) NEFMOD=143
  1471. IF (ITYP1.EQ. 7) NEFMOD=144
  1472. IF (ITYP1.EQ.11) NEFMOD=145
  1473. IF (ITYP1.EQ.33) NEFMOD=146
  1474. IF (ITYP1.EQ.34) NEFMOD=147
  1475. IF (ITYP1.EQ.35) NEFMOD=148
  1476. IF (ITYP1.EQ.36) NEFMOD=149
  1477. C Il nous manque la pyramide
  1478. IF (NEFMOD.EQ.0) GO TO 99
  1479. ELSE IF (LESTEF(1).EQ.'LINB') THEN
  1480. NEFMOD=0
  1481. IF (ITYP1.EQ. 3) NEFMOD=158
  1482. IF (ITYP1.EQ. 7) NEFMOD=159
  1483. IF (ITYP1.EQ.11) NEFMOD=160
  1484. IF (ITYP1.EQ.33) NEFMOD=161
  1485. IF (ITYP1.EQ.34) NEFMOD=162
  1486. C IF (ITYP1.EQ.35) NEFMOD=163
  1487. C IF (ITYP1.EQ.36) NEFMOD=164
  1488. C Il nous manque la pyramide et le tetrahedre
  1489. IF (NEFMOD.EQ.0) GOTO 99
  1490. ELSE
  1491. DO i=1,ITEF
  1492. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1493. IF (MELE.EQ.0) GOTO 99
  1494. MEGE=NUMGEO(MELE)
  1495. IF (MEGE.EQ.0) GOTO 99
  1496. IF (MEGE.EQ.ITYP1) GOTO 610
  1497. ENDDO
  1498. GO TO 99
  1499. 610 NEFMOD=MELE
  1500. ENDIF
  1501. C Cas de la FORMULATION 'EULER'
  1502. ELSE IF (LESFOR(1).EQ.'EULER') THEN
  1503. NEFMOD=0
  1504. IF (ITYP1.EQ. 2) NEFMOD=ITYP1
  1505. IF (ITYP1.EQ. 4) NEFMOD=ITYP1
  1506. IF (ITYP1.EQ. 8) NEFMOD=ITYP1
  1507. IF (ITYP1.EQ.14) NEFMOD=ITYP1
  1508. IF (ITYP1.EQ.16) NEFMOD=ITYP1
  1509. IF (ITYP1.EQ.23) NEFMOD=ITYP1
  1510. IF (ITYP1.EQ.25) NEFMOD=ITYP1
  1511. IF (NEFMOD.EQ.0) GOTO 99
  1512. C Cas des autres FORMULATIONs
  1513. ELSE
  1514. DO i=1,ITEF
  1515. if(lestef(i)(1:4).eq.'BBAR') CALL MODE20(ITYP1,LESTEF(I))
  1516. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1517. IF (MELE.EQ.0) GOTO 99
  1518. MEGE=NUMGEO(MELE)
  1519. IF (MEGE.EQ.0) GOTO 99
  1520. IF (MEGE.EQ.ITYP1) GOTO 6
  1521. c kich cas du POI1
  1522. if (ityp1.eq.1) goto 6
  1523. ENDDO
  1524. GOTO 99
  1525. C Cas particulier pour les elements polygonaux
  1526. 6 IF (ITYP1.EQ.32) THEN
  1527. MELE=MELE+NBNN-3
  1528. IF (NBNN.GT.14) GOTO 99
  1529. ENDIF
  1530. NEFMOD=MELE
  1531. ENDIF
  1532. C Affectation des elements finis de maniere automatique
  1533. ELSE
  1534. C Cas des milieux POREUX
  1535. IF (LESFOR(1).EQ.'POREUX') THEN
  1536. NEFMOD=0
  1537. IF (ITYP1.EQ. 6) NEFMOD=79
  1538. IF (ITYP1.EQ.10) NEFMOD=80
  1539. IF (ITYP1.EQ.15) NEFMOD=81
  1540. IF (ITYP1.EQ.24) NEFMOD=82
  1541. IF (ITYP1.EQ.17) NEFMOD=83
  1542. IF (ITYP1.EQ.29) NEFMOD=108
  1543. IF (ITYP1.EQ.30) NEFMOD=109
  1544. IF (ITYP1.EQ.31) NEFMOD=110
  1545. IF (NEFMOD.EQ.0) GOTO 99
  1546. C Cas des elements de frottement (formulation FROTTEMENT)
  1547. ELSE IF (LESFOR(1).EQ.'CONTACT') THEN
  1548. C * NEFMOD=22 pv est passe par la
  1549. NEFMOD=0
  1550. if(ifrtt.eq.1) then
  1551. IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=107
  1552. IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=165
  1553. elseif(ifroca.ne.0) then
  1554. IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=261
  1555. IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=262
  1556. endif
  1557. C IF (NEFMOD.EQ.0) GOTO 99
  1558. C Cas des elements hybrides (imposes en DARCY)
  1559. ELSE IF (LESFOR(1).EQ.'DARCY') THEN
  1560. NEFMOD=0
  1561. IF (ITYP1.EQ. 3) NEFMOD=143
  1562. C IF (ITYP1.EQ. 4) NEFMOD=99
  1563. C IF (ITYP1.EQ. 8) NEFMOD=100
  1564. C IF (ITYP1.EQ.23) NEFMOD=101
  1565. C IF (ITYP1.EQ.16) NEFMOD=102
  1566. C IF (ITYP1.EQ.14) NEFMOD=103
  1567. IF (ITYP1.EQ. 7) NEFMOD=99
  1568. IF (ITYP1.EQ.11) NEFMOD=100
  1569. IF (ITYP1.EQ.35) NEFMOD=101
  1570. IF (ITYP1.EQ.34) NEFMOD=102
  1571. IF (ITYP1.EQ.33) NEFMOD=103
  1572. IF (NEFMOD.EQ.0) GOTO 99
  1573. C Cas de la formulation MAGNETODYNAMIQUE
  1574. ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  1575. NEFMOD=0
  1576. IF (ITYP1.EQ. 4) NEFMOD=128
  1577. IF (NEFMOD.EQ.0) GOTO 99
  1578. C Cas de la formulation 'NAVIER_STOKES'
  1579. ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN
  1580. IF (ILNAVI.EQ.0) THEN
  1581. CALL MESLIR(-341)
  1582. GOTO 990
  1583. ELSEIF (ILNAVI.EQ.1) THEN
  1584. C LICE
  1585. NEFMOD=0
  1586. IF (ITYP1.EQ. 3) NEFMOD=195
  1587. IF (ITYP1.EQ. 7) NEFMOD=196
  1588. IF (ITYP1.EQ.11) NEFMOD=197
  1589. IF (ITYP1.EQ.33) NEFMOD=198
  1590. IF (ITYP1.EQ.34) NEFMOD=199
  1591. IF (ITYP1.EQ.35) NEFMOD=200
  1592. IF (ITYP1.EQ.36) NEFMOD=201
  1593. IF (NEFMOD.EQ.0) GOTO 99
  1594. ELSEIF (ILNAVI.EQ.2) THEN
  1595. C LIMS
  1596. NEFMOD=0
  1597. IF (ITYP1.EQ. 3) NEFMOD=202
  1598. IF (ITYP1.EQ. 7) NEFMOD=203
  1599. IF (ITYP1.EQ.11) NEFMOD=204
  1600. IF (ITYP1.EQ.33) NEFMOD=205
  1601. IF (ITYP1.EQ.34) NEFMOD=206
  1602. IF (ITYP1.EQ.35) NEFMOD=207
  1603. IF (ITYP1.EQ.36) NEFMOD=208
  1604. IF (NEFMOD.EQ.0) GOTO 99
  1605. ELSEIF (ILNAVI.EQ.3) THEN
  1606. C LBMS
  1607. NEFMOD=0
  1608. IF (ITYP1.EQ. 3) NEFMOD=209
  1609. IF (ITYP1.EQ. 7) NEFMOD=210
  1610. IF (ITYP1.EQ.11) NEFMOD=211
  1611. IF (ITYP1.EQ.33) NEFMOD=212
  1612. IF (ITYP1.EQ.34) NEFMOD=213
  1613. IF (ITYP1.EQ.35) NEFMOD=214
  1614. IF (ITYP1.EQ.36) NEFMOD=215
  1615. IF (NEFMOD.EQ.0) GOTO 99
  1616. ELSEIF (ILNAVI.EQ.4) THEN
  1617. C MCCE
  1618. NEFMOD=0
  1619. IF (ITYP1.EQ. 3) NEFMOD=216
  1620. IF (ITYP1.EQ. 7) NEFMOD=217
  1621. IF (ITYP1.EQ.11) NEFMOD=218
  1622. IF (ITYP1.EQ.33) NEFMOD=219
  1623. IF (ITYP1.EQ.34) NEFMOD=220
  1624. IF (ITYP1.EQ.35) NEFMOD=221
  1625. IF (ITYP1.EQ.36) NEFMOD=222
  1626. IF (NEFMOD.EQ.0) GOTO 99
  1627. ELSEIF (ILNAVI.EQ.5) THEN
  1628. C MCP1
  1629. NEFMOD=0
  1630. IF (ITYP1.EQ. 3) NEFMOD=223
  1631. IF (ITYP1.EQ. 7) NEFMOD=224
  1632. IF (ITYP1.EQ.11) NEFMOD=225
  1633. IF (ITYP1.EQ.33) NEFMOD=226
  1634. IF (ITYP1.EQ.34) NEFMOD=227
  1635. IF (ITYP1.EQ.35) NEFMOD=228
  1636. IF (ITYP1.EQ.36) NEFMOD=229
  1637. IF (NEFMOD.EQ.0) GOTO 99
  1638. ELSEIF (ILNAVI.EQ.6) THEN
  1639. C MCMS
  1640. NEFMOD=0
  1641. IF (ITYP1.EQ. 3) NEFMOD=230
  1642. IF (ITYP1.EQ. 7) NEFMOD=231
  1643. IF (ITYP1.EQ.11) NEFMOD=232
  1644. IF (ITYP1.EQ.33) NEFMOD=233
  1645. IF (ITYP1.EQ.34) NEFMOD=234
  1646. IF (ITYP1.EQ.35) NEFMOD=235
  1647. IF (ITYP1.EQ.36) NEFMOD=236
  1648. IF (NEFMOD.EQ.0) GOTO 99
  1649. ELSEIF (ILNAVI.EQ.7) THEN
  1650. C QFCE
  1651. NEFMOD=0
  1652. IF (ITYP1.EQ. 3) NEFMOD=237
  1653. IF (ITYP1.EQ. 7) NEFMOD=238
  1654. IF (ITYP1.EQ.11) NEFMOD=239
  1655. IF (ITYP1.EQ.33) NEFMOD=240
  1656. IF (ITYP1.EQ.34) NEFMOD=241
  1657. IF (ITYP1.EQ.35) NEFMOD=242
  1658. IF (ITYP1.EQ.36) NEFMOD=243
  1659. IF (NEFMOD.EQ.0) GOTO 99
  1660. ELSEIF (ILNAVI.EQ.8) THEN
  1661. C QFP1
  1662. NEFMOD=0
  1663. IF (ITYP1.EQ. 3) NEFMOD=244
  1664. IF (ITYP1.EQ. 7) NEFMOD=245
  1665. IF (ITYP1.EQ.11) NEFMOD=246
  1666. IF (ITYP1.EQ.33) NEFMOD=247
  1667. IF (ITYP1.EQ.34) NEFMOD=248
  1668. IF (ITYP1.EQ.35) NEFMOD=249
  1669. IF (ITYP1.EQ.36) NEFMOD=250
  1670. IF (NEFMOD.EQ.0) GOTO 99
  1671. ELSEIF (ILNAVI.EQ.9) THEN
  1672. C QFMS
  1673. NEFMOD=0
  1674. IF (ITYP1.EQ. 3) NEFMOD=251
  1675. IF (ITYP1.EQ. 7) NEFMOD=252
  1676. IF (ITYP1.EQ.11) NEFMOD=253
  1677. IF (ITYP1.EQ.33) NEFMOD=254
  1678. IF (ITYP1.EQ.34) NEFMOD=255
  1679. IF (ITYP1.EQ.35) NEFMOD=256
  1680. IF (ITYP1.EQ.36) NEFMOD=257
  1681. IF (NEFMOD.EQ.0) GOTO 99
  1682. ENDIF
  1683. C Cas de la formulation 'EULER'
  1684. ELSE IF (LESFOR(1).EQ.'EULER') THEN
  1685. NEFMOD=0
  1686. IF (ITYP1.EQ. 2) NEFMOD=ITYP1
  1687. IF (ITYP1.EQ. 4) NEFMOD=ITYP1
  1688. IF (ITYP1.EQ. 8) NEFMOD=ITYP1
  1689. IF (ITYP1.EQ.14) NEFMOD=ITYP1
  1690. IF (ITYP1.EQ.16) NEFMOD=ITYP1
  1691. IF (ITYP1.EQ.23) NEFMOD=ITYP1
  1692. IF (ITYP1.EQ.25) NEFMOD=ITYP1
  1693. IF (NEFMOD.EQ.0) GOTO 99
  1694. C Cas des autres formulations
  1695. ELSE
  1696. NEFMOD=ITYP1
  1697. c kich cas du POI1
  1698. if (ityp1.eq.1) nefmod = 45
  1699. C Cas particuliers des elements polygonaux
  1700. IF (NEFMOD.EQ.32) NEFMOD=111+NBNN -3
  1701. C Cas particuliers des elements finis pour IDIM=1
  1702. IF (IDIM.EQ.1) THEN
  1703. NEFMOD=0
  1704. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  1705. IF (ICONV.NE.0 .OR. iraye.NE.0) THEN
  1706. IF (ITYP1.EQ.1) NEFMOD=45
  1707. IF (ITYP1.EQ.2) NEFMOD=ITYP1
  1708. ELSE
  1709. IF (ITYP1.EQ.2) NEFMOD=191
  1710. IF (ITYP1.EQ.3) NEFMOD=192
  1711. ENDIF
  1712. ELSE IF (LESFOR(1).EQ.'MECANIQUE') THEN
  1713. IF (ITYP1.EQ.2) NEFMOD=193
  1714. IF (ITYP1.EQ.3) NEFMOD=194
  1715. ELSE IF (LESFOR(1).EQ.'FISSURE') THEN
  1716. IF (ITYP1.EQ.2) NEFMOD=ITYP1
  1717. ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN
  1718. IF (ITYP1.EQ.2) NEFMOD=193
  1719. IF (ITYP1.EQ.3) NEFMOD=194
  1720. ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN
  1721. IF (ITYP1.EQ.2) NEFMOD=193
  1722. IF (ITYP1.EQ.3) NEFMOD=194
  1723. ENDIF
  1724. ENDIF
  1725. IF (NEFMOD.EQ.0) GOTO 99
  1726. MELE=NEFMOD
  1727. ENDIF
  1728. ENDIF
  1729. C fin de le determination de NEFMOD zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz
  1730.  
  1731. C Poursuite du remplissage du IM-eme modele elementaire IMODEL
  1732. IF (NMAT.NE.0) THEN
  1733. IF (LESFOR(1).EQ.'MELANGE') THEN
  1734. MATMOD(1)=LESPRO(1)
  1735. ELSE
  1736. DO i=1,NMAT
  1737. MATMOD(i)=LESPRO(i)
  1738. ENDDO
  1739. ENDIF
  1740. ENDIF
  1741.  
  1742.  
  1743. 11 CONTINUE
  1744. DO i=1,NFOR
  1745. FORMOD(i)=LESFOR(i)
  1746. ENDDO
  1747. IF (MN3.NE.0) INFMOD(1)=NPINT
  1748. C (fdp) Pour les elements JOI1 seulement, on stocke -1*ILIE dans
  1749. C INFMOD(9) (il semble que INFMOD(8) soit utilise par-ci par-la)
  1750. IF (ILIE.NE.0) THEN
  1751. IF (NEFMOD.NE.265) THEN
  1752. CALL ERREUR(19)
  1753. GOTO 990
  1754. ENDIF
  1755. INFMOD(9)=-1*ILIE
  1756. ENDIF
  1757. * AM cas non-local
  1758. IF(INLOC.NE.0) THEN
  1759. INFMOD(13)=-1*INLOC
  1760. INFMOD(14)=LULVIA
  1761. ENDIF
  1762. IF (NPINT.NE.0.AND.NEFMOD.NE.28) THEN
  1763. CALL ERREUR(608)
  1764. GOTO 990
  1765. ENDIF
  1766. C Verification de l'existence du MMODEL
  1767. IF(ITYP1.NE.48) THEN
  1768. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU)
  1769. IF (CMATE.EQ.' ') THEN
  1770. write(ioimp,*) ' petit probleme apres nomate'
  1771. CALL ERREUR(251)
  1772. GOTO 990
  1773. ENDIF
  1774. ENDIF
  1775. C* Petit cas particulier en cas de modele VISCO_EXTERNE :
  1776. C* On recupere IVIEX stocke dans INATU (cf. NOMATE)
  1777. IF (INATU.LE.-2) THEN
  1778. IVIEX = -2 - INATU
  1779. INATU = -2
  1780. C* TYMODE(LMEIVI)='IVIEX '
  1781. IVAMOD(LMEIVI)= IVIEX
  1782. ENDIF
  1783. C
  1784. ideriv=jderiv
  1785. CMATEE=CMATE
  1786. IMATEE=IMATE
  1787. INATUU=INATU
  1788. C initialisation des nomid
  1789. IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER'.AND.
  1790. & FORMOD(1).NE.'MELANGE' ) THEN
  1791. c linomid=false quand on ne veut pas aller dans inomid
  1792. if (formod(1).EQ.'LIAISON') then
  1793. linomid=.false.
  1794. else
  1795. linomid=.true.
  1796. do jn = 1,matmod(/2)
  1797. if (matmod(jn).eq.'MODAL' .or.
  1798. & matmod(jn).eq.'STATIQUE' .or.
  1799. & matmod(jn).eq.'IMPEDANCE' ) linomid =.false.
  1800. enddo
  1801. endif
  1802.  
  1803. C cas particulier des relations de conformite
  1804. c on recupere les noms de composantes
  1805. c seulement 'DEPLACEM' et 'FORCES ' pour les SURE
  1806. if(ITYP1.EQ.48) then
  1807. segini,IMODE5=IMODEL
  1808. IMODE5.NEFMOD=NEPAPA
  1809. call inomid(IMODE5,' ',iret,lucvar,lucmat,
  1810. & lucmaf,luparx)
  1811. LNOMID(1)=IMODE5.LNOMID(1)
  1812. LNOMID(2)=IMODE5.LNOMID(2)
  1813. segsup,IMODE5
  1814. NOMID=LNOMID(1)
  1815. SEGACT,NOMID
  1816. NOMID=LNOMID(2)
  1817. SEGACT,NOMID
  1818. else
  1819. if (linomid) call inomid(imodel,' ',
  1820. & iret,lucvar,lucmat,lucmaf,luparx)
  1821. endif
  1822.  
  1823. ELSE
  1824. linomid=.true.
  1825. ENDIF
  1826.  
  1827. C Quelques tests supplementaires en attendant mieux
  1828. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  1829. C nnz = MATMOD(/2)
  1830. iplaz = 0
  1831. call place(MATMOD,MATMOD(/2),iplaz,'PHASE')
  1832. IF (iplaz.ne.0 ) THEN
  1833. c test que les elements sont lineaires
  1834. ipt4 = imamod
  1835. segact ipt4
  1836. itt = ipt4.itypel
  1837. c* segdes ipt4
  1838. if (kdegre(itt) .gt. 2) then
  1839. call erreur(982)
  1840. goto 990
  1841. endif
  1842. ENDIF
  1843. endif
  1844. IF (LESFOR(1).EQ.'MECANIQUE') THEN
  1845. C Cas du materiau unidirectionnel
  1846. IF (IMATE.EQ.4) THEN
  1847. MFR=NUMMFR(NEFMOD)
  1848. C Cas des cerces : sans interet !
  1849. IF (MFR.EQ.27) THEN
  1850. CALL ERREUR(251)
  1851. GOTO 990
  1852. ENDIF
  1853. C Cas de la plasticite
  1854. IF (INATU.NE.0) THEN
  1855. C OK si massif bidim ou si coque tridim dans le cas acier_uni
  1856. IF (INATU.EQ.40)THEN
  1857. IF ((MFR.NE.1.OR.IFOUR.GT.0).AND.
  1858. . ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN
  1859. CALL ERREUR(251)
  1860. GOTO 990
  1861. ENDIF
  1862. C Dans les autres cas, on n'autorise pour le moment que COQ2 et massif
  1863. ELSE IF (MELE.NE.44.AND.MFR.NE.1) THEN
  1864. CALL ERREUR(251)
  1865. GOTO 990
  1866. ENDIF
  1867. ENDIF
  1868. ENDIF
  1869. C
  1870. C Cas du materiau 'ZONE_COHESIVE'
  1871. IF (IMATE.EQ.12) THEN
  1872. MFR=NUMMFR(NEFMOD)
  1873. IF (MFR.NE.77) THEN
  1874. CALL ERREUR(251)
  1875. GOTO 990
  1876. ENDIF
  1877. ENDIF
  1878.  
  1879. C Cas du modele section : on n'autorise pour le moment que TIMO
  1880. IF (CMATE.EQ.'SECTION'.AND.MELE.NE.84) THEN
  1881. CALL ERREUR(251)
  1882. GOTO 990
  1883. ENDIF
  1884. ENDIF
  1885. C Le modele de GURSON n'est possible qu'en 3D, axisymetrique ou
  1886. C deformations planes
  1887. IF (INATU.EQ.38) THEN
  1888. IF ( (IFOUR.NE.0).AND.(IFOUR.NE.2).AND.(IFOUR.NE.-1) ) THEN
  1889. MOTERR(1:8)='GURSON'
  1890. MOTERR(9:16)='MECANIQU'
  1891. INTERR(1) = IFOUR
  1892. CALL ERREUR (81)
  1893. GOTO 990
  1894. ENDIF
  1895. ENDIF
  1896.  
  1897. C Le modele ISS_GRANGE n'est utilisable qu'en 3D
  1898. IF ((INATU.EQ.151).AND.(IFOUR.NE.2)) THEN
  1899. INTERR(1) = IFOUR
  1900. CALL ERREUR (709)
  1901. GOTO 990
  1902. ENDIF
  1903. C Le modele RUP_THER n'est utilisable qu'en 3D
  1904. IF ((INATU.EQ.152).AND.(IFOUR.NE.2)) THEN
  1905. INTERR(1) = IFOUR
  1906. CALL ERREUR (709)
  1907. GOTO 990
  1908. ENDIF
  1909. C Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1
  1910. IF ((INATU.EQ.34).AND.(IFOUR.NE.2)
  1911. . .AND.(NUMMFR(NEFMOD).EQ.75)) THEN
  1912. INTERR(1) = IFOUR
  1913. CALL ERREUR (709)
  1914. GOTO 990
  1915. ENDIF
  1916. C.. Restrictions en formulation 'MECANIQUE' avec une loi de
  1917. C comportement non lineaire externe
  1918. C Rappel : LMEEXT exprime la condition (NFOR.EQ.1) ET
  1919. C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
  1920. IF ( LMEEXT ) THEN
  1921. C En formulation 'MECANIQUE', les lois non lineaires externes
  1922. C n'autorisent qu'une seule composante de temperature
  1923. C => incompatibilite avec des modeles de coques n'ayant pas
  1924. C de points d'integration dans l'epaisseur (trois composantes
  1925. C dans ce cas, 'TINF', 'T ' et 'TSUP')
  1926. C Le test ci-dessous est coherent avec celui de IDTEMP.
  1927. MFR = NUMMFR(NEFMOD)
  1928. IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND.
  1929. . (NPINT.EQ.0) ) THEN
  1930. CALL ERREUR(951)
  1931. GOTO 990
  1932. ENDIF
  1933. C Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour
  1934. C l'instant qu'aux elements massifs, avec option de calcul 3D
  1935. C Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL'
  1936. IF ( LMEVIX ) THEN
  1937. IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN
  1938. KERRE = 950
  1939. ELSE IF ( IVIEX.NE.1 ) THEN
  1940. KERRE = 958
  1941. ELSE
  1942. KERRE = 0
  1943. ENDIF
  1944. IF (KERRE.NE.0) THEN
  1945. CALL ERREUR(KERRE)
  1946. GOTO 990
  1947. ENDIF
  1948. ENDIF
  1949. ENDIF
  1950. C Formulation 'THERMIQUE' 'CONVECTION'
  1951. C Adequation EF de type COQue et mot 'INFERIEURE' / 'SUPERIEURE'
  1952. IF (ICONV.EQ.1) THEN
  1953. CALL PLACE(LESPRO,NMAT,ISUP,'SUPERIEURE')
  1954. CALL PLACE(LESPRO,NMAT,IINF,'INFERIEURE')
  1955. ITOT = ISUP+IINF
  1956. IF (ITOT.NE.0.AND.NEFMOD.NE.27.AND.NEFMOD.NE.41.AND.
  1957. . NEFMOD.NE.44.AND.NEFMOD.NE.49.AND.NEFMOD.NE.56) THEN
  1958. CALL ERREUR(16)
  1959. GOTO 990
  1960. ENDIF
  1961. IF (ITOT.EQ.0.AND.(NEFMOD.EQ.27.OR.NEFMOD.EQ.41.OR.
  1962. . NEFMOD.EQ.44.OR.NEFMOD.EQ.49.OR.NEFMOD.EQ.56)) THEN
  1963. CALL ERREUR(513)
  1964. GOTO 990
  1965. ENDIF
  1966. ENDIF
  1967.  
  1968. C Formulation 'DIFFUSION' :
  1969. IF (LESFOR(1) .EQ. 'DIFFUSION') THEN
  1970. C - Verification sur les types de FORMULATION et/ou d'elements
  1971. MFR1 = NUMMFR(nefmod)
  1972. IF ((IFOUR.EQ.2 .AND. NEFMOD.GE.4 .AND. NEFMOD.LT.11) .OR.
  1973. & (MFR1.NE.1 .AND. MFR1.NE.3 .AND. MFR1.NE.5 .AND.
  1974. & MFR1.NE.7 .AND. MFR1.NE.9 .AND. MFR1.NE.73.AND.
  1975. & MFR1.NE.27)) THEN
  1976. CALL ERREUR(16)
  1977. GOTO 99
  1978. ENDIF
  1979.  
  1980. C - Modele UTILISATEUR :
  1981. C Verification que les composantes "lineaires" sont declarees
  1982. IF (LDIEXT) THEN
  1983. CALL IDDILI(IMATE,0, MOCOMP,NBROBL,NBRFAC)
  1984. MLMOTS = MOCOMP
  1985. MLMOT1 = lucmat
  1986. SEGACT,MLMOT1
  1987. NBCOMP = MLMOT1.MOTS(/2)
  1988. ICOMP = 0
  1989. DO i = 1, NBROBL
  1990. CALL PLACE(MLMOT1.MOTS,NBCOMP,IPLAC,MOTS(i))
  1991. IF (IPLAC.EQ.0) THEN
  1992. WRITE(IOIMP,80) MOTS(i)
  1993. 80 FORMAT('La composante obligatoire ',A8,' est absente')
  1994. ELSE
  1995. ICOMP = ICOMP+1
  1996. ENDIF
  1997. ENDDO
  1998. SEGDES,MLMOT1
  1999. SEGSUP,MLMOTS
  2000. IF (ICOMP.NE.NBROBL) THEN
  2001. GOTO 99
  2002. ENDIF
  2003. ENDIF
  2004. ENDIF
  2005. C Formulation 'ELECTROSTATIQUE' :
  2006. C Petite verification (a priori sans probleme)
  2007. IF (LESFOR(1) .EQ. 'ELECTROSTATIQUE') THEN
  2008. MFR1 = NUMMFR(nefmod)
  2009. IF (MFR1.NE.1) THEN
  2010. CALL ERREUR(21)
  2011. GOTO 99
  2012. ENDIF
  2013. ENDIF
  2014.  
  2015. C kich
  2016. c 11 CONTINUE
  2017. C initialisation du infele et des segment d'integration
  2018. IF (LESFOR(1).EQ.'MECANIQUE' .OR. LESFOR(1).EQ.'POREUX'.OR.
  2019. $ LESFOR(1).EQ.'LIQUIDE' .OR. LESFOR(1).EQ.'DIFFUSION' .OR.
  2020. $ LESFOR(1).EQ.'ELECTROSTATIQUE' .OR.
  2021. $ LESFOR(1).EQ.'CHARGEMENT' .OR.
  2022. $ NFOR.EQ.2 ) THEN
  2023. infele(2)=npint
  2024. infele(3)=ngmas
  2025. infele(4)=ngcon
  2026. infele(6)=ngrig
  2027. call prquoi (imodel)
  2028. endif
  2029.  
  2030. C initialisation des nomid (cas particuliers)
  2031. if (.not.linomid) then
  2032. if (irmot1.eq.1) then
  2033. mlmot5 = jlmot1
  2034. mlmot6 = jlmot2
  2035. segact mlmot5,mlmot6
  2036. if (mlmot5.mots(/2).ne.mlmot6.mots(/2)) call erreur(26)
  2037. lucvar = jlmot1
  2038. lucmat = jlmot2
  2039. nobmod = 2
  2040. segadj imodel
  2041. ivamod(1) = jlmot1
  2042. ivamod(2) = jlmot2
  2043. tymode(1) = 'LISTMOTS'
  2044. tymode(2) = 'LISTMOTS'
  2045. endif
  2046. call prquoi (imodel)
  2047. call inomid(imodel,' ',iret,lucvar,lucmat,lucmaf,luparx)
  2048. endif
  2049. C kich
  2050. C Verification de non redondance des nom des composantes
  2051. C sauf pour les formulations Navier_Stokes et Euler
  2052. mfr2 = 0
  2053. IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER'.AND.
  2054. $ FORMOD(1).NE.'CHARGEMENT') THEN
  2055. ipmo=imodel
  2056. mfr1=NUMMFR(nefmod)
  2057. mfr2 = infele(13)
  2058. segact imodel*mod
  2059. CALL cotemo(ipmo,mfr2)
  2060. IF (IERR.NE.0) RETURN
  2061. ENDIF
  2062. C IF (IM.EQ.1) MFRTMP=mfr1
  2063.  
  2064. C Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14)
  2065. C Ce point n'est pris en compte que si cela est necessaire
  2066. MFR3=MFR2
  2067. IF (FORMOD(1).EQ.'CHARGEMENT') MFR3=INFELE(13)
  2068. CALL INFDPG(mfr3,IFOUR, LOGRE,ndpge)
  2069. IF (LOGRE) THEN
  2070. C Erreur si ce point support n'est pas fourni avec le mot-cle GENE.
  2071. IF (IPTGEN.EQ.0) THEN
  2072. CALL ERREUR(925)
  2073. RETURN
  2074. ENDIF
  2075. imodel.IPDPGE = IPTGEN
  2076. ELSE
  2077. IF (IPTGEN.NE.0) THEN
  2078. write(ioimp,*) 'Mot-cle GENE + Point ignores...'
  2079. ENDIF
  2080. imodel.IPDPGE = 0
  2081. ENDIF
  2082. SEGDES,IMODEL
  2083. 10 CONTINUE
  2084. C ****************************************************
  2085. C fin de boucle sur les sous-parties du maillages
  2086. C *************************************************
  2087.  
  2088. DO 68 K=1,MMODEL.KMODEL(/1)
  2089. IMODE5=MMODEL.KMODEL(K)
  2090. SEGACT IMODE5
  2091. IF (IMODE5.NEFMOD.NE.22 ) GOTO 68
  2092. IPT3=IMODE5.IMAMOD
  2093. SEGACT IPT3
  2094. 68 CONTINUE
  2095. IPMODE=MMODEL
  2096. C construction modeles elementaires pour MELANGE cccccccccccccc
  2097. C une loi de melange pointe sur des modeles
  2098. C elementaires de meme support
  2099. lomela = .true.
  2100. IF (LESFOR(1).eq.'MELANGE') THEN
  2101. segini limode
  2102. do 500 ilm = 1,NMAT1
  2103. IF (LESMOD(ilm).GT.0) THEN
  2104. n1 = nsou1
  2105. segini mmode2
  2106. WRITE(CONM,FMT='(I16)') mmode2
  2107. segsup mmode2
  2108. do 511 im = 1,nsou1
  2109. imodel = kmodel(im)
  2110. IF (ilm.eq.1) THEN
  2111. segact imodel*mod
  2112. nmat = 1
  2113. mn3 = infmod(/1)
  2114. nfor = 1
  2115. nobmod = ivamod(/1)
  2116. segadj imodel
  2117. ELSE
  2118. segact imodel
  2119. MN3 = infmod(/1)
  2120. NFOR = 1
  2121. NMAT = 1
  2122. NOBMOD = 0
  2123. segini imode2
  2124. imode2.imamod = imamod
  2125. imode2.nefmod = nefmod
  2126. if (mn3.gt.0) then
  2127. do imm = 1,mn3
  2128. imode2.infmod(imm) = infmod(imm)
  2129. enddo
  2130. endif
  2131. imode2.formod(1) = 'MELANGE'
  2132. imode2.IPDPGE = IPDPGE
  2133. imode2.conmod = conm
  2134. imode2.conmod(17:24) = pham
  2135. imodel = imode2
  2136. limode(**) = imodel
  2137. matmod(1) = lespro(ilm)
  2138. ENDIF
  2139. c lmomat = 0
  2140. c lmovar = 0
  2141. MMODE1 = LESMOD(ilm)
  2142. SEGACT MMODE1
  2143. kbmod = ivamod(/1)
  2144. nobmod = kbmod + MMODE1.KMODEL(/1)
  2145. segadj imodel
  2146. DO 515 im1 = 1,MMODE1.KMODEL(/1)
  2147. imode1 = mmode1.kmodel(im1)
  2148. segact imode1
  2149. mfo1 = imode1.formod(/2)
  2150. mma1 = imode1.matmod(/2)
  2151. if (imode1.conmod(17:24).eq.' ') then
  2152. write(ioimp,*) 'pas de nom de phase pour MELANGE '
  2153. lomela = .false.
  2154. endif
  2155. IF (imodel.imamod.eq.imode1.imamod) THEN
  2156. C quelques verifs
  2157. if (matmod(1).eq.'SERIE'.and.im1.gt.1) then
  2158. do im2 = 1,MMODE1.KMODEL(/1)
  2159. imode2 = mmode1.kmodel(im2)
  2160. segact imode2
  2161. mfo2 = imode2.formod(/2)
  2162. mma2 = imode2.matmod(/2)
  2163. if (mfo1.eq.mfo2.and.imode1.formod(mfo1).eq.imode2.formod(mfo2))
  2164. & then
  2165. C * pas de phase identique dans la meme fomulation
  2166. C * if (imode1.conmod(17:24).eq.imode2.conmod(17:24)) lomela =.false.
  2167. if (mma1.ne.mma2.OR.
  2168. & imode1.matmod(mma1).ne.imode2.matmod(mma2)) lomela = .false.
  2169.  
  2170. endif
  2171. enddo
  2172. endif
  2173. IF (.NOT.lomela) THEN
  2174. C *** detruire
  2175. C 509 CONTINUE
  2176. do imu1 = 1,MMODE1.KMODEL(/1)
  2177. IMODE1 = MMODE1.KMODEL(imu1)
  2178. segdes imode1
  2179. enddo
  2180. segdes mmode1
  2181. call erreur(251)
  2182. goto 990
  2183. ENDIF
  2184. C ***
  2185. kbmod = kbmod + 1
  2186. tymode(kbmod) = 'IMODEL'
  2187. ivamod(kbmod) = imode1
  2188. ENDIF
  2189. 515 CONTINUE
  2190.  
  2191. nobmod = kbmod
  2192. segadj imodel
  2193. MFR = NUMMFR(NEFMOD)
  2194. CALL IDMATR(MFR,IMODEL,IPNOMC,NOBL,NFAC)
  2195. segdes imodel
  2196. 511 continue
  2197. do 503 im1 = 1,MMODE1.KMODEL(/1)
  2198. IMODE1 = MMODE1.KMODEL(im1)
  2199. segdes imode1
  2200. 503 continue
  2201. segdes mmode1
  2202. ELSE
  2203. do im = 1,nsou1
  2204. imodel = kmodel(im)
  2205. segact imodel*mod
  2206. nmat = 1
  2207. segadj imodel
  2208. enddo
  2209. ENDIF
  2210. 500 continue
  2211. n1i = kmodel(/1)
  2212. N1 = kmodel(/1) + limode(/1)
  2213. segadj mmodel
  2214. do 502 is = 1,limode(/1)
  2215. kmodel(n1i + is) = limode(is)
  2216. 502 continue
  2217. segsup limode
  2218. ENDIF
  2219. C fin des lois melanges ccccccccccccccccccccccccccccccccccccccccccccc
  2220. C
  2221. C traitement si en entree des modèles
  2222. 70 CONTINUE
  2223. IF (iremod.gt.0) THEN
  2224. do im = 1,kmodel(/1)
  2225. imodel = kmodel(im)
  2226. segact imodel*mod
  2227. if (CONM.NE.' ') conmod = CONM
  2228. if (PHAM.NE.' ') conmod(17:24) = PHAM
  2229. C Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14)
  2230. mfr2 = infele(13)
  2231. IF (FORMOD(1).EQ.'CHARGEMENT') MFR2=0
  2232. CALL INFDPG(mfr2,IFOUR, LOGRE,ndpge)
  2233. IF (LOGRE) THEN
  2234. C Erreur si le point support n'est pas fourni avec le mot-cle GENE.
  2235. IF (IPTGEN.EQ.0) THEN
  2236. CALL ERREUR(925)
  2237. RETURN
  2238. ENDIF
  2239. imodel.IPDPGE = IPTGEN
  2240. ELSE
  2241. C* IF (IPTGEN.NE.0) THEN
  2242. C* write(ioimp,*) 'Mot-cle GENE + Point ignores...'
  2243. C* ENDIF
  2244. imodel.IPDPGE = 0
  2245. ENDIF
  2246. if (NPINT.GT.0) write(ioimp,*) 'ne change pas le nb pts inte'
  2247. segdes imodel
  2248. enddo
  2249. ENDIF
  2250. C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd
  2251. C cas du mot cle STAT : pointer le modele elementaire approprie
  2252.  
  2253. IF (ipmod1.gt.0) THEN
  2254. MMODE1 = ipmod1
  2255. SEGACT MMODE1
  2256. DO im1 = 1,MMODE1.KMODEL(/1)
  2257. IMODE1 = MMODE1.KMODEL(im1)
  2258. segact imode1
  2259. ENDDO
  2260. DO im = 1,kmodel(/1)
  2261. imodel = kmodel(im)
  2262. segact imodel*mod
  2263. nobmod = ivamod(/1)
  2264. nobmod = nobmod + 1
  2265. nfor = formod(/2)
  2266. nmat = matmod(/2)
  2267. mn3 = infmod(/1)
  2268. segadj imodel
  2269. kbmod = 0
  2270. do im1 = 1,MMODE1.KMODEL(/1)
  2271. imode1 = mmode1.kmodel(im1)
  2272. imomo = imode1
  2273. lostat = .true.
  2274. C criteres de verif assez faibles ...
  2275. if (imode1.nefmod.eq.nefmod.and.
  2276. & imode1.imamod.ne.imamod.and.
  2277. & imode1.matmod(/2).eq.matmod(/2).and.
  2278. & imode1.formod(/2).eq.formod(/2)) then
  2279. do lmo = 1,formod(/2)
  2280. if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false.
  2281. enddo
  2282. do lmo = 1,matmod(/2)
  2283. if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false.
  2284. enddo
  2285. else
  2286. lostat = .false.
  2287. endif
  2288. if (lostat.and.formod(1).eq.'MELANGE') then
  2289. C verifs supplementaires : les modeles de ivamod sont ils bien construi
  2290. lomela = .true.
  2291. if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false.
  2292. if (imode1.ivamod(/1).gt.0) then
  2293. do ivm3 = 1,imode1.ivamod(/1)
  2294. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2295. imode3 = imode1.ivamod(ivm3)
  2296. segact imode3
  2297. ENDIF
  2298. enddo
  2299. endif
  2300. IF (nobmod.gt.1) THEN
  2301. do ivm1 = 1,(nobmod-1)
  2302. imode2 = ivamod(ivm1)
  2303. segact imode2
  2304. cc
  2305. if (imode2.ivamod(/1).ge.1) then
  2306. do ivm2 = 1,imode2.ivamod(/1)
  2307. if (imode2.tymode(ivm2).eq.'STATIO') then
  2308. imode4 = imode2.ivamod(ivm2)
  2309. segact imode4
  2310. if (imode1.ivamod(/1).ge.1) then
  2311. do ivm3 = 1,imode1.ivamod(/1)
  2312. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2313. imode3 = imode1.ivamod(ivm3)
  2314. cc
  2315. lostat = .true.
  2316. C criteres de verif assez faibles ...
  2317. if (imode3.nefmod.eq.imode4.nefmod.and.
  2318. & imode3.imamod.eq.imode4.imamod.and.
  2319. & imode3.matmod(/2).eq.imode4.matmod(/2).and.
  2320. & imode3.conmod(17:24).eq.imode4.conmod(17:24).and.
  2321. & imode3.formod(/2).eq.imode4.formod(/2)) then
  2322. do lmo = 1,imode4.formod(/2)
  2323. if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false.
  2324. enddo
  2325. do lmo = 1,imode4.matmod(/2)
  2326. if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false.
  2327. enddo
  2328. else
  2329. lostat = .false.
  2330. endif
  2331. if (lostat) then
  2332. segdes imode4
  2333. goto 75
  2334. endif
  2335. cc
  2336. ENDIF
  2337. enddo
  2338. else
  2339. lostat = .false.
  2340. endif
  2341. endif
  2342. segdes imode4
  2343. enddo
  2344. C
  2345. else
  2346. lomela = .false.
  2347. endif
  2348. 75 lomela = lomela.and.lostat
  2349. segdes imode2
  2350. enddo
  2351. ENDIF
  2352. lostat = lomela
  2353. do ivm3 = 1,imode1.ivamod(/1)
  2354. c imode1 = imomo
  2355. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2356. imode3 = imode1.ivamod(ivm3)
  2357. segdes imode3
  2358. ENDIF
  2359. enddo
  2360. endif
  2361. if (lostat) then
  2362. kbmod = kbmod + 1
  2363. tymode(nobmod) = 'STATIO'
  2364. ivamod(nobmod) = imomo
  2365. goto 79
  2366. endif
  2367. enddo
  2368. C *** ca se passe mal
  2369. if (kbmod.ne.1) then
  2370. do im1 = 1,MMODE1.KMODEL(/1)
  2371. IMODE1 = MMODE1.KMODEL(im1)
  2372. segdes imode1
  2373. enddo
  2374. segdes mmode1
  2375. write(ioimp,*) ' STATIO EN DEFAUT voir notice '
  2376. call erreur(251)
  2377. goto 990
  2378. endif
  2379. C ***
  2380. 79 segdes imodel
  2381. ENDDO
  2382. DO im1 = 1,MMODE1.KMODEL(/1)
  2383. IMODE1 = MMODE1.KMODEL(im1)
  2384. segdes imode1
  2385. ENDDO
  2386. SEGDES MMODE1
  2387. ENDIF
  2388. C fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd
  2389.  
  2390. IF (IPGEOM.NE.0) SEGDES,MELEME
  2391. C Ecriture de l'objet MODELE cree
  2392. SEGDES,MMODEL
  2393. CALL ECROBJ('MMODEL',IPMODE)
  2394. RETURN
  2395.  
  2396. C Traitement des ERREURS
  2397. 99 CONTINUE
  2398. CALL ERREUR(21)
  2399. 990 CONTINUE
  2400. DO imu = 1, kmodel(/1)
  2401. imodel = kmodel(imu)
  2402. IF (imodel.NE.0) SEGSUP,imodel
  2403. ENDDO
  2404. SEGSUP,MMODEL
  2405. IF (IPGEOM.NE.0) SEGDES,MELEME
  2406. RETURN
  2407.  
  2408. END
  2409.  
  2410.  
  2411.  
  2412.  

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