Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

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

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