Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

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

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