Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

modeli
  1. C MODELI SOURCE JK148537 25/02/17 21:15:08 12156
  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 PPARAM
  23. -INC CCOPTIO
  24. -INC CCHAMP
  25. -INC CCGEOME
  26. C==DEB= FORMULATION HHO == Include specifique ==========================
  27. -INC CCHHOPA
  28. C==FIN= FORMULATION HHO ================================================
  29.  
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMMODEL
  33. POINTEUR IMODE3.IMODEL,IMODE4.IMODEL,IMODE5.IMODEL
  34. POINTEUR nomid1.NOMID,nomid2.NOMID
  35. -INC SMTABLE
  36. -INC SMLMOTS
  37. POINTEUR OPNLIN.MLMOTS
  38.  
  39. SEGMENT LIMODE(0)
  40. SEGMENT PLICON
  41. integer mlicon(NLCON),tlicon(NLCON)
  42. ENDSEGMENT
  43.  
  44. EXTERNAL LONG
  45. PARAMETER (NBFORM=19,NBCON=14,NBEXT=7,NBDIF=1)
  46. PARAMETER (N1MAX=300,N2MAX=200)
  47. PARAMETER (NLOMAX=5)
  48.  
  49. DIMENSION LESMOD(N1MAX)
  50. CHARACTER*4 MOTEF(N2MAX),LESTEF(N2MAX),MOCON(NBCON),MOEXT(NBEXT),
  51. & MOINCO(NBDIF)
  52. CHARACTER*4 MNLOCA(NLOMAX),MNLVAR(1)
  53. CHARACTER*4 MCTCT(4)
  54. CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,CMATE,PHAM
  55. CHARACTER*8 PAR1,MDIINC,MDIDUA
  56. CHARACTER*(LCONMO) CONM
  57. CHARACTER*(LOCOMP) MOPRID
  58. CHARACTER*16 MOFORM(NBFORM),LESFOR(2),MOPROP(N1MAX),LESPRO(N1MAX)
  59. CHARACTER*16 LMENOM,LDINOM,OPTEMP(3)
  60. CHARACTER*(LOCHAI) MOTEMP,LMELIB,LDILIB,LMEFCT,LDIFCT
  61. CHARACTER*4 mgauss(4)
  62. CHARACTER*4 deriv(1)
  63.  
  64. LOGICAL LOGRE,LOGIN,LMEEXT,LMENLX,LMEVIX,LOSTAT,LOMELA,LINOMID
  65. LOGICAL LDIEXT,LDISOR,LOBBAR
  66.  
  67. C=DEB==== FORMULATION HHO ==== Declarations particulieres ==============
  68. PARAMETER (NMHHO=2)
  69. CHARACTER*4 mcHHO(NMHHO)
  70. CHARACTER*(LOCHAI) chaHHO
  71. LOGICAL loHHO
  72. DATA mcHHO / 'HHO_','HHO ' /
  73. C=FIN==== FORMULATION HHO ==============================================
  74.  
  75. DATA MGAUSS /'EPAI' , 'RIGI' , 'MASS' ,'CONT'/
  76. DATA DERIV /'EPSI'/
  77. c DATA MDERIV/'LINEAIRE ','QUADRATIQUE ',
  78. c $ 'TRUESDELL ','JAUMANN ',
  79. c $ 'UTILISATEUR ','FEFP '/
  80. DATA OPTEMP/'PHASE ','ADVECTION ',
  81. $ 'CONDUCTION '/
  82.  
  83. C----------------------------------------------------------------------C
  84. C DEFINITION DES NOMS DE FORMULATIONS C
  85. C Formulation LIAISON : pour operateurs DYNE et COMP C
  86. C----------------------------------------------------------------------C
  87. DATA MOFORM /
  88. & 'THERMIQUE ','MECANIQUE ','LIQUIDE ',
  89. & 'POREUX ','DARCY ','CONTACT ',
  90. & 'MAGNETODYNAMIQUE','NAVIER_STOKES ','MELANGE ',
  91. & 'EULER ','FISSURE ','LIAISON ',
  92. & 'THERMOHYDRIQUE ','ELECTROSTATIQUE ','DIFFUSION ',
  93. & 'CHARGEMENT ','METALLURGIE ','CHANGEMENT_PHASE',
  94. & 'CONTRAINTE ' /
  95.  
  96. C (fdp) Ajout d'un nouveau mot clef 'LIBRE' ou 'LIE' pour les JOI1
  97. DATA MOCON / 'CONS','INTE','DPGE','PHAS','STAT','LCOI','LCOS',
  98. & 'LIBR','LIE ','NON_','LINE','CHPO','GAP7','COMP'/
  99. DATA MOEXT / 'NUME','NOM_','PARA','C_MA','C_VA','LIB_','FCT_' /
  100. DATA MOINCO / 'INCO' /
  101. DATA MNLVAR/ 'V_MO' /
  102. DATA MCTCT/'MESC','FAIB','SYME','MORT'/
  103.  
  104. CONM =' '
  105. PHAM =' '
  106. MDIINC=' '
  107. MDIDUA=' '
  108.  
  109. MFR = 0
  110. lucvar = 0
  111. lucmat = 0
  112. lucmaf = 0
  113. luparx = 0
  114. lobbar = .false.
  115. lecont = 0
  116. C=DEB==== FORMULATION HHO ==== Initialisations particulieres ===========
  117. loHHO = .FALSE.
  118. C=FIN==== FORMULATION HHO ==============================================
  119.  
  120. mmode2 = 0
  121.  
  122. IPTABL = 0
  123. IPTABS = 0
  124. IPTABM = 0
  125. IPTBMO = 0
  126. IPTBDM = 0
  127. IPTMOD = 0
  128. IPGEOM = 0
  129. C Lecture d'une table BASE_MODALE
  130. CALL LIRTAB('BASE_MODALE',IPTABL,0,IRET)
  131. IF (IERR.NE.0) RETURN
  132. IF (IRET.GT.0) THEN
  133. IPTBMO=IPTABL
  134. IVALIN=0
  135. XVALIN=REAL(0.D0)
  136. LOGIN=.TRUE.
  137. IOBIN=0
  138. TAPIND='MOT '
  139. CHARIN='MODES'
  140. TYPOBJ='TABLE '
  141. CALL ACCTAB(IPTBMO,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  142. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  143. IF (IERR.NE.0) RETURN
  144. IPTBDM = IOBRE
  145. IVALIN=0
  146. XVALIN=REAL(0.D0)
  147. LOGIN=.TRUE.
  148. IOBIN=0
  149. TAPIND='MOT '
  150. CHARIN='MAILLAGE'
  151. TYPOBJ='MAILLAGE'
  152. CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  153. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  154. IF (IERR.NE.0) RETURN
  155. IPMAIL = IOBRE
  156. IVALIN=1
  157. XVALIN=REAL(0.D0)
  158. LOGIN=.TRUE.
  159. IOBIN=0
  160. TAPIND='ENTIER '
  161. CHARIN=' '
  162. TYPOBJ='TABLE'
  163. CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  164. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  165. IF (IERR.NE.0) RETURN
  166.  
  167. IPTMOD = IOBRE
  168. IVALIN=0
  169. XVALIN=REAL(0.D0)
  170. LOGIN=.TRUE.
  171. IOBIN=0
  172. TAPIND='MOT '
  173. TYPOBJ='POINT'
  174. CALL ACCTAB(IPTMOD,TAPIND,IVALIN,XVALIN,'POINT_REPERE',LOGIN,
  175. . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  176. IF (IERR.NE.0) RETURN
  177. NBNN = 1
  178. NBELEM = 1
  179. NBSOUS = 0
  180. NBREF = 0
  181. SEGINI IPT8
  182. IPT8.ITYPEL = 1
  183. IPT8.NUM(1,1) = IOBRE
  184. IPGEOM = IPT8
  185. IRET = 0
  186. ENDIF
  187.  
  188. C Lecture d'une table STATIONNAIRE
  189. CALL LIRTAB('STATIONNAIRE',IPTABL,0,IRET)
  190. IF (IERR.NE.0) RETURN
  191. IF (IRET.GT.0) THEN
  192. IPTABS=IPTABL
  193. IVALIN=0
  194. XVALIN=REAL(0.D0)
  195. LOGIN=.TRUE.
  196. IOBIN=0
  197. TAPIND='MOT '
  198. CHARIN='MAILLAGE'
  199. TYPOBJ='TABLE '
  200. CALL ACCTAB(IPTABS,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  201. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  202. IF (IERR.NE.0) RETURN
  203. IPTABM = IOBRE
  204. IVALIN=1
  205. XVALIN=REAL(0.D0)
  206. LOGIN=.TRUE.
  207. IOBIN=0
  208. TAPIND='ENTIER '
  209. CHARIN=' '
  210. TYPOBJ='MAILLAGE'
  211. CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  212. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  213. IF (IERR.NE.0) RETURN
  214. IPGEOM = IOBRE
  215. IRET = 0
  216. ENDIF
  217.  
  218. C Lecture d'une TABLE de sous-type MAILLAGE
  219. IF(IPTABM.EQ.0) THEN
  220. CALL LIRTAB('MAILLAGE',IPTABL,0,IRET)
  221. IF (IERR.NE.0) RETURN
  222. IF (IRET.GT.0) THEN
  223. IPTABM = IPTABL
  224. IVALIN=1
  225. XVALIN=REAL(0.D0)
  226. LOGIN=.TRUE.
  227. IOBIN=0
  228. TAPIND='ENTIER '
  229. CHARIN=' '
  230. TYPOBJ='MAILLAGE'
  231. CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  232. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  233. IF (IERR.NE.0) RETURN
  234. IPGEOM = IOBRE
  235. IRET = 0
  236. ENDIF
  237. ENDIF
  238.  
  239. C Lecture d'un MAILLAGE ou d'une TABLE de sous-type DOMAINE
  240. IPTABL = 0
  241. IPGEO2 = 0
  242. IReMOD = 0
  243. CALL LIRTAB('DOMAINE',IPTABL,0,IRET)
  244. IF (IERR.NE.0) RETURN
  245. IF (IPTABL.GT.0) THEN
  246. IVALIN=0
  247. XVALIN=REAL(0.D0)
  248. LOGIN=.TRUE.
  249. IOBIN=0
  250. TAPIND='MOT '
  251. CHARIN='MAILLAGE'
  252. TYPOBJ='MAILLAGE'
  253. CALL ACCTAB(IPTABL,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  254. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  255. IF (IERR.NE.0) RETURN
  256. IPGEOM = IOBRE
  257. ENDIF
  258.  
  259. C Lecture d'un MAILLAGE (cas general) :
  260. IF (IPGEOM.LE.0) THEN
  261. CALL LIROBJ('MAILLAGE',IPGEOM,1,IRET)
  262. IF (IERR.NE.0) RETURN
  263. ENDIF
  264.  
  265. C Verification de l'unicite des elements
  266. c On ne tient pas compte de l'ordre des noeuds dans l'element
  267. IPT1 = IPGEOM
  268. iordre=0
  269. CALL UNIQMA(IPT1,NBDI1,iordre)
  270. IF (NBDI1 .NE. 0) THEN
  271. MOTERR(1:8)='MAILLAGE'
  272. CALL ERREUR(1019)
  273. RETURN
  274. ENDIF
  275.  
  276. C Lecture d'une FORMULATION
  277. NFOR =0
  278. NMAT =0
  279. CALL MESLIR(-182)
  280. ICOND=1
  281. CALL MESLIR(-182)
  282.  
  283. 51 CONTINUE
  284. CALL LIRMOT(MOFORM,NBFORM,IPFORM,ICOND)
  285. IF (IERR.NE.0) RETURN
  286. IF (IPFORM .EQ. 0) GOTO 52
  287.  
  288. NFOR=NFOR+1
  289. IF (NFOR.GT.2) THEN
  290. CALL ERREUR(251)
  291. RETURN
  292. ENDIF
  293. LESFOR(NFOR)=MOFORM(IPFORM)
  294. ICOND=0
  295. CALL MESLIR(-181)
  296. GOTO 51
  297.  
  298. 52 CONTINUE
  299. C Cas d'une FORMULATION simple (NFOR=1)
  300. IF (NFOR.EQ.1) THEN
  301. c jderiv=mepsil
  302. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  303. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  304. CALL MODEL1(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  305. ELSE IF(LESFOR(1).EQ.'MECANIQUE') THEN
  306. CALL MODEL2(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  307. ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN
  308. CALL MODEL3(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  309. ELSE IF(LESFOR(1).EQ.'POREUX') THEN
  310. CALL MODEL6(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  311. ELSE IF(LESFOR(1).EQ.'DARCY') THEN
  312. CALL MODEL7(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  313. ELSE IF(LESFOR(1).EQ.'CONTACT') THEN
  314. CALL MODEL8(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  315. ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  316. CALL MODE10(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  317. ELSE IF(LESFOR(1).EQ.'NAVIER_STOKES') THEN
  318. CALL MODE11(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  319. ELSE IF (LESFOR(1).EQ.'MELANGE') THEN
  320. CALL MODE12(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  321. DO i=1,N1MAX
  322. LESMOD(i)=0
  323. ENDDO
  324. ELSE IF(LESFOR(1).EQ.'EULER') THEN
  325. CALL MODE13(MOPROP,NPROP,NBTEF,N1MAX)
  326. ELSE IF(LESFOR(1).EQ.'FISSURE') THEN
  327. CALL MODE14(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  328. ELSE IF(LESFOR(1).EQ.'LIAISON') THEN
  329. CALL MODE15(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  330. ELSE IF(LESFOR(1).EQ.'THERMOHYDRIQUE') THEN
  331. CALL MODE16(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  332. ELSE IF(LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN
  333. CALL MODE17(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  334. ELSE IF(LESFOR(1).EQ.'DIFFUSION ') THEN
  335. CALL MODE18(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  336. ELSE IF(LESFOR(1).EQ.'CHARGEMENT ') THEN
  337. CALL MODE19(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  338. ELSE IF(LESFOR(1).EQ.'METALLURGIE ') THEN
  339. cjk148537 : ce n'est pas l exemple a suivre
  340. CALL MODE21(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  341. ELSE IF(LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
  342. CALL MODE22(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  343. ELSE IF(LESFOR(1).EQ.'CONTRAINTE') THEN
  344. CALL MODE24(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  345. ELSE
  346. CALL ERREUR (251)
  347. ENDIF
  348. IF (IERR.NE.0) RETURN
  349.  
  350. ELSE
  351. C Cas d'une FORMULATION couplee (NFOR=2)
  352. c jderiv=mepsil
  353. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  354. IF ((LESFOR(1).EQ.'LIQUIDE'.AND.LESFOR(2).EQ.'MECANIQUE').OR.
  355. & (LESFOR(2).EQ.'LIQUIDE'.AND.LESFOR(1).EQ.'MECANIQUE')) THEN
  356. CALL MODEL5(NPROP,MOTEF,NBTEF,N2MAX)
  357. ELSE
  358. CALL ERREUR(251)
  359. ENDIF
  360. IF (IERR.NE.0) RETURN
  361. ENDIF
  362.  
  363. C Lecture eventuelle des proprietes du MODELE de MATERIAU
  364. ifrtt = 0
  365. IFROCA = 0
  366. ifacaf = 0
  367. isyme = 0
  368. nbga = 10
  369. nbdang = 3
  370. icavit = 0
  371. kjh = 0
  372. ISRCE = 0
  373. IRAYE = 0
  374. ICONV = 0
  375. NMAT = 0
  376. iprop = 0
  377. ipgeo2 = 0
  378. if (iptabm.gt.0.and.iptabs.eq.0) goto 674
  379. IF (NPROP.EQ.0) GOTO 43
  380. CALL MESLIR(-180)
  381. 41 CONTINUE
  382. IF (NMAT .NE.0) CALL MESLIR(-179)
  383. CALL LIRMOT(MOPROP,NPROP,LAPROP,0)
  384. IF (IERR.NE.0) RETURN
  385.  
  386. C ---------- Cas d'un MODELE de CONTACT
  387. IF(LESFOR(1).EQ.'CONTACT') then
  388. * si FROTTANT lecont=3
  389. if(laprop.eq.3) lecont=laprop
  390. if(laprop.eq.5) then
  391. ifrtt=0
  392. ifroca=1
  393. C call lirobj('MMODEL',IFROCA,1,iOK)
  394. C IF(ierr.NE.0) return
  395. Call lirobj('MAILLAGE',IBETON,1,IOK)
  396. IF(ierr.NE.0) return
  397. endif
  398. if(laprop.eq.4) then
  399. ifrtt=1
  400. endif
  401. ENDIF
  402.  
  403. C ---------- Cas d'un MODELE de CONTRAINTE
  404. IF(LESFOR(1).EQ.'CONTRAINTE') then
  405. if(laprop.ne.0) then
  406. lactr=laprop
  407. NMAT=NMAT+1
  408. LESPRO(NMAT)=MOPROP(LAPROP)
  409. endif
  410. if (lactr.ne.0) goto 42
  411. ENDIF
  412.  
  413. C ---------- Cas d'un MODELE de METALLURGIE
  414. C modele cree par T.L. en mai 2018
  415. IF (lesfor(1).eq.'METALLURGIE' .AND. NMAT.le.4 ) THEN
  416. NMAT=NMAT+1
  417. IF( laprop .eq. 1 ) THEN
  418. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(1)='PHASES'
  419. CALL LIROBJ('LISTMOTS', lucvar, 1, IRETOU)
  420. MLMOTS = lucvar
  421. segact MLMOTS
  422. NB_PHA = MLMOTS.MOTS(/2)
  423. C On remplira ensuite MATMOD() avec lespro()
  424. cjk148537 lespro(laprop) = MOPROP(laprop)
  425.  
  426. ELSEIF( laprop .eq. 2 ) THEN
  427. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(2)='REACTIFS'
  428. CALL LIROBJ('LISTMOTS', ireact, 1, IRETOU)
  429. MLMOT1 = ireact
  430. segact MLMOT1
  431. NB_REA = MLMOT1.MOTS(/2)
  432. C On remplira ensuite MATMOD() avec lespro()
  433. cjk148537 lespro(laprop) = MOPROP(laprop)
  434.  
  435. ELSEIF( laprop .eq. 3 ) THEN
  436. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(3)='PRODUITS'
  437. CALL LIROBJ('LISTMOTS', iprodu, 1, IRETOU)
  438. MLMOT2 = iprodu
  439. segact MLMOT2
  440. NB_PRO = MLMOT2.MOTS(/2)
  441. C On remplira ensuite MATMOD() avec lespro()
  442. cjk148537 lespro(laprop) = MOPROP(laprop)
  443.  
  444. ELSEIF( laprop .eq. 4 ) THEN
  445. C On vas lire le LISTMOTS qui suit le mot-clef MOPROP(4)='TYPE'
  446. CALL LIROBJ('LISTMOTS', lucmat, 1, IRETOU)
  447. MLMOT3 = lucmat
  448. segact MLMOT3
  449. NB_TYP = MLMOT3.MOTS(/2)
  450. C On remplira ensuite MATMOD() avec lespro()
  451. do jj = 1,nb_typ
  452. lespro(jj) = mlmot3.mots(jj)
  453. enddo
  454.  
  455. ELSE
  456. CALL ERREUR(5)
  457. RETURN
  458. ENDIF
  459.  
  460. C Les pointeurs lucvar et lucmat sont ensuite transmis a
  461. C inomid pour remplir les NOMID de l'objet MMODEL
  462. C Les pointeurs lucvar, ireact, iprodu, lucmat seront mis
  463. C dans le tableau IVAMOD de l'objet IMODEL
  464.  
  465. IF(NMAT .lt. 4) THEN
  466. C On n'a pas encore recuperer toutes les donnees
  467. go to 41
  468.  
  469. ELSE IF(NMAT .eq. 4) THEN
  470.  
  471. C On emet une erreur si les MLMOTS 'REACTIFS', 'PRODUITS' et
  472. C 'TYPES' n'ont pas ete luts
  473. if(ireact .le. 0 .OR. iprodu .le. 0 .OR. lucmat .le. 0) then
  474. CALL ERREUR(21)
  475. RETURN
  476. endif
  477.  
  478. C Autant de produits que de reactifs
  479. if( NB_PRO .ne. NB_REA ) then
  480. CALL ERREUR(1078)
  481. RETURN
  482. endif
  483.  
  484. C On initialise le MLMOTS des PHASES si celui ci n'a pas ete lu
  485. icompt = 0
  486. if( lucvar .le. 0) then
  487. icompt = 1
  488. NB_PHA = NB_REA + NB_PRO
  489. JGN = LOCOMP
  490. JGM = NB_PHA
  491. SEGINI, MLMOTS
  492. lucvar = MLMOTS
  493. C On remplira ensuite MATMOD() avec lespro()
  494. lespro(1) = MOPROP(1)
  495. endif
  496.  
  497. C On a recuperer toutes les donnees, on effectue quelques tests
  498. do ipha = 1, NB_PRO
  499.  
  500. C Produits differents du reactif pour chaque reaction
  501. if( MLMOT1.MOTS(ipha) .eq. MLMOT2.MOTS(ipha) ) then
  502. MOTERR(1:4)=MLMOT1.MOTS(ipha)
  503. MOTERR(5:8)=MLMOT2.MOTS(ipha)
  504. CALL ERREUR(1075)
  505. RETURN
  506. endif
  507.  
  508. irphas = 0
  509. ipphas = 0
  510. CALL PLACE(MLMOTS.MOTS, NB_PHA, irphas, MLMOT1.MOTS(ipha))
  511. CALL PLACE(MLMOTS.MOTS, NB_PHA, ipphas, MLMOT2.MOTS(ipha))
  512. C Si le nom du produit ou du reactif n'a pas ete lu dans le
  513. C MLMOTS des PHASES :
  514. C On le rajoute si lucvar n'avait pas ete lu
  515. C On emet une erreur sinon
  516. if(irphas .eq. 0) then
  517. if( icompt .ge. 1 ) then
  518. MLMOTS.MOTS(icompt) = MLMOT1.MOTS(ipha)
  519. icompt = icompt + 1
  520. else
  521. MOTERR(1:4)=MLMOT1.MOTS(ipha)
  522. CALL ERREUR(1080)
  523. RETURN
  524. endif
  525. endif
  526. if(ipphas .eq. 0) then
  527. if( icompt .ge. 1 ) then
  528. MLMOTS.MOTS(icompt) = MLMOT2.MOTS(ipha)
  529. icompt = icompt + 1
  530. else
  531. MOTERR(1:4)=MLMOT2.MOTS(ipha)
  532. CALL ERREUR(1080)
  533. RETURN
  534. endif
  535. endif
  536.  
  537. enddo
  538. C On corrige la taille de MLMOTS :
  539. if( icompt .ge. 1 ) then
  540. JGM = icompt - 1
  541. JGN = MLMOTS.MOTS(/1)
  542. SEGADJ, MLMOTS
  543. endif
  544.  
  545. C Un type de reaction definit pour chaque reaction
  546. if( NB_TYP .ne. NB_PRO ) then
  547. CALL ERREUR(1077)
  548. RETURN
  549. endif
  550.  
  551. LAPROP = 0
  552.  
  553. segact,MLMOTS*NOMOD, MLMOT1*NOMOD, MLMOT2*NOMOD, MLMOT3*NOMOD
  554. ENDIF
  555. ENDIF
  556.  
  557. C ---------- Cas d'un MODELE de THERMIQUE CONVECTION ou RAYONNEMENT
  558. IF (lesfor(1).eq.'THERMIQUE' .AND. kjh.eq.0) then
  559. IF (moprop(laprop).eq.'CONVECTION') then
  560. ICONV=1
  561. nmat=nmat+1
  562. kjh=1
  563. lespro(nmat)=moprop(laprop)
  564. call model4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  565. go to 41
  566. ELSE IF (moprop(laprop).eq.'RAYONNEMENT') then
  567. IRAYE=1
  568. kjh=1
  569. nmat=nmat+1
  570. lespro(nmat)=moprop(laprop)
  571. call model9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  572. go to 41
  573. ELSE IF (moprop(laprop).eq.'SOURCE') then
  574. ISRCE=1
  575. kjh=1
  576. nmat=nmat+1
  577. lespro(nmat)=moprop(laprop)
  578. call mode23(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  579. go to 41
  580. ENDIF
  581. ENDIF
  582.  
  583. C ---------- Cas d'un MODELE de RAYONNEMENT
  584. IF (IRAYE.EQ.1) then
  585. if(laprop.eq.1) icavit=1
  586. if(laprop.eq.9) then
  587. call lirent( nbdang,1,iretou)
  588. if(ierr.ne.0) return
  589. endif
  590. if(laprop.eq.8) then
  591. call lirent( nbga,1,iretou)
  592. if(ierr.ne.0) return
  593. endif
  594. if(laprop.eq.7)then
  595. isyme=1
  596. call lirobj('POINT',ipp1,1,iretou)
  597. if(ierr.ne.0) return
  598. call lirobj('POINT',ipp2,1,iretou)
  599. if(idim.eq.3)call lirobj('POINT',ipp3,1,iretou)
  600. if(ierr.ne.0) return
  601. endif
  602. if(laprop.eq.2) then
  603. ifacaf=1
  604. call lirobj('MAILLAGE',ipfac1,1,iretou)
  605. if(ierr.ne.0) return
  606. call lirobj('MAILLAGE',ipfac2,1,iretou)
  607. if(ierr.ne.0) return
  608. call lirobj('MAILLAGE',ipfac3,1,iretou)
  609. if(ierr.ne.0) return
  610. call lirobj('MMODEL' ,imoco ,1,iretou)
  611. if(ierr.ne.0) return
  612. call actobj('MAILLAGE',ipfac1,1)
  613. call actobj('MAILLAGE',ipfac2,1)
  614. call actobj('MAILLAGE',ipfac3,1)
  615. call actobj('MMODEL' ,imoco,1)
  616. endif
  617. if (ierr.ne.0) return
  618. ENDIF
  619.  
  620. C ---------- MODELE de SOURCE
  621. IF (ISRCE.EQ.1) then
  622. C Par DEFAUT, formulation generale (initialement "UNIFORME")
  623. C IF (laprop.eq.0) THEN
  624. C nmat=nmat+1
  625. C lespro(nmat)=moprop(1)
  626. C ENDIF
  627. ISRCE=ISRCE+1
  628. ELSEIF (ISRCE.EQ.2) THEN
  629. IF (lespro(nmat).EQ.'GAUSSIENNE') THEN
  630. IF (IDIM.EQ.1) THEN
  631. INTERR(1) = IDIM
  632. CALL ERREUR(1104)
  633. RETURN
  634. ENDIF
  635. C Source Gaussienne : par DEFAUT, SPHERIQUE
  636. IF (laprop.eq.0) THEN
  637. nmat=nmat+1
  638. lespro(nmat)=moprop(2)
  639. ELSE IF (laprop.eq.4) THEN
  640. IF (IDIM.LT.3) THEN
  641. INTERR(1)=IDIM
  642. CALL ERREUR(709)
  643. RETURN
  644. ENDIF
  645. ENDIF
  646. ENDIF
  647. ISRCE=ISRCE+1
  648. ENDIF
  649.  
  650. C ---------- Cas d'un MODELE de MELANGE
  651. IF (LESFOR(1).EQ.'MELANGE') THEN
  652. CALL LIROBJ('MMODEL',ipmod,0,iOK)
  653. IF (IERR.NE.0) RETURN
  654. C ----- le melange par defaut est 'PARALLELE'
  655. IF (iOK.EQ.1) THEN
  656. CALL ACTOBJ('MMODEL',ipmod,1)
  657. IF (IERR.NE.0) RETURN
  658. IF (LAPROP.EQ.0) LAPROP=3
  659. LESMOD(1)=ipmod
  660. ENDIF
  661. ENDIF
  662. C
  663. IF (LAPROP .EQ. 0) GOTO 42
  664. NMAT=NMAT+1
  665. LESPRO(NMAT)=MOPROP(LAPROP)
  666. GOTO 41
  667.  
  668. 42 CONTINUE
  669.  
  670. IF (NMAT .NE. 0) THEN
  671. C on teste tout de suite l'existence de la donnee de la derivee
  672. C il ne faut pas de modele de materiau commencant par deri
  673. nmit=nmat
  674. do i=1,nmit
  675. if( lespro(i)(1:4).eq.'EPSI') then
  676. call erreur(19)
  677. return
  678. endif
  679. enddo
  680.  
  681. C on cherche le mot 'EPSI'
  682. CALL LIRMOT(deriv,1,itrou,0)
  683. IF(itrou.ne.0) THEN
  684. c call lirmot(mderiv,5,iret,1)
  685. c if(ierr.ne.0) return
  686. c Jderiv=iret
  687. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  688. MOTERR(1:40)='MODE ... EPSI ... ;'
  689. CALL ERREUR(1056)
  690. RETURN
  691. ENDIF
  692.  
  693. IF (LESFOR(1).EQ.'THERMIQUE'.AND.ISRCE.EQ.0) THEN
  694. C +---------------------------------------------------------+
  695. C | FORMULATION THERMIQUE : 'ISOTROPE' |
  696. C +---------------------------------------------------------+
  697. IPROP = 3
  698. IF (IDIM.EQ.1) IPROP = 1
  699. CALL PLACE(MOPROP,IPROP,IPLAC,LESPRO(1))
  700. IF (IPLAC.EQ.0) THEN
  701. DO i=NMAT,1,-1
  702. LESPRO(i+1)=LESPRO(i)
  703. ENDDO
  704. LESPRO(1)='ISOTROPE'
  705. NMAT=NMAT+1
  706. ELSEif(NMAT.EQ.1)THEN
  707. NMAT=NMAT+1
  708. LESPRO(2)='CONDUCTION'
  709. ENDIF
  710.  
  711. C Ajout du mot 'CONDUCTION' si besoin avec phase et advection
  712. idoico=0
  713. idejco=0
  714. DO i=1,nmat
  715. CALL PLACE (OPTEMP,3,iplac,LESPRO(i))
  716. if(iplac.eq.1.or.iplac.eq.2) idoico=1
  717. if(iplac.eq.3) idejco=1
  718. enddo
  719.  
  720. if( idoico.ne.0.and.idejco.eq.0) then
  721. nmat=nmat+1
  722. lespro(nmat)='CONDUCTION'
  723. endif
  724.  
  725. ELSEIF (LESFOR(1).EQ.'MECANIQUE'.OR. LESFOR(1).EQ.'POREUX') THEN
  726. C +----------------------------------------------------------+
  727. C | FORMULATION MECANIQUE / POREUX : 'ELASTIQUE' 'ISOTROPE' |
  728. C +----------------------------------------------------------+
  729. IF (NMAT.GE.2)THEN
  730. CALL MODELA(MOPROP,NMOD)
  731. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(2))
  732. IF (IPLAC.EQ.0) THEN
  733. DO i=NMAT,2,-1
  734. LESPRO(i+1)=LESPRO(i)
  735. ENDDO
  736. LESPRO(2)='ISOTROPE'
  737. NMAT=NMAT+1
  738. ENDIF
  739. ELSE IF (NMAT.EQ.1) THEN
  740. LESPRO(2)='ISOTROPE'
  741. NMAT=2
  742. ENDIF
  743. C MECANIQUE / POREUX : modele par defaut en comportement non lineaire
  744. CALL MODNLI(MOPROP,NMOD)
  745. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
  746. C Par defaut : PLASTIQUE ISOTROPE
  747. IF (IPLAC.EQ.1) THEN
  748. NMAT=NMAT+1
  749. LESPRO(NMAT)='ISOTROPE'
  750. C Par defaut : FLUAGE NORTON
  751. ELSE IF (IPLAC.EQ.2) THEN
  752. NMAT=NMAT+1
  753. LESPRO(NMAT)='NORTON'
  754. C Par defaut : VISCOPLASTIQUE ONERA
  755. ELSE IF (IPLAC.EQ.3) THEN
  756. NMAT=NMAT+1
  757. LESPRO(NMAT)='ONERA'
  758. C Par defaut : ENDOMMAGEMENT MAZARS
  759. ELSE IF (IPLAC.EQ.4) THEN
  760. NMAT=NMAT+1
  761. LESPRO(NMAT)='MAZARS'
  762. C Par defaut : ENDOMMAGEMENT PLASTIQUE P/Y
  763. ELSE IF (IPLAC.EQ.5) THEN
  764. NMAT=NMAT+1
  765. LESPRO(NMAT)='PSURY'
  766. ELSE IF (IPLAC.EQ.6) THEN
  767. C Si 'MECANIQUE' OU 'POREUX' : pas de comportement par defaut
  768. C pour 'NON_LINEAIRE'
  769. CALL ERREUR(945)
  770. RETURN
  771. ELSE IF (IPLAC.EQ.7) THEN
  772. C Si 'MECANIQUE' : pas de comportement par defaut pour 'VISCO_EXTERNE'
  773. IF (LESFOR(1).EQ.'MECANIQUE') THEN
  774. CALL ERREUR(946)
  775. C Si 'POREUX' : option non implementee
  776. ELSE IF (LESFOR(1).EQ.'POREUX') THEN
  777. CALL ERREUR(251)
  778. ENDIF
  779. RETURN
  780. ENDIF
  781.  
  782. ELSEIF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  783. C +---------------------------------------------------------------+
  784. C | FORMULATION MAGNETODYNAMIQUE : 'POTENTIEL_VECTEUR' 'ISOTROPE' |
  785. C +---------------------------------------------------------------+
  786. IF (NMAT.EQ.1) THEN
  787. IF (LESPRO(1).NE.'POTENTIEL_VECTEU') THEN
  788. LESPRO(2)=LESPRO(1)
  789. LESPRO(1)='POTENTIEL_VECTEU'
  790. ELSE
  791. LESPRO(2)='ISOTROPE'
  792. ENDIF
  793. NMAT=2
  794. ENDIF
  795.  
  796. ELSEIF (LESFOR(1).EQ.'MELANGE' ) THEN
  797. C +-------------------------------+
  798. C | FORMULATION MELANGE : 'CEREM' |
  799. C +-------------------------------+
  800. NMAT1=NMAT
  801. IF (NMAT.EQ.0) THEN
  802. LESPRO(1)='CEREM'
  803. NMAT=1
  804. ENDIF
  805.  
  806. ELSEIF (LESFOR(1).EQ.'LIAISON' ) THEN
  807. C +-------------------------------------------------+
  808. C | FORMULATION LIAISON : pas d''option par defaut |
  809. C +-------------------------------------------------+
  810.  
  811. ELSEIF (LESFOR(1).EQ.'ELECTROSTATIQUE' ) THEN
  812. C +-------------------------------------------+
  813. C | FORMULATION ELECTROSTATIQUE : 'ISOTROPE' |
  814. C +-------------------------------------------+
  815. IPROP = 3
  816. IF (IDIM.EQ.1) IPROP = 1
  817. CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1))
  818. IF (IPLAC.EQ.0) THEN
  819. DO i=NMAT,1,-1
  820. LESPRO(i+1)=LESPRO(i)
  821. ENDDO
  822. LESPRO(1)='ISOTROPE'
  823. NMAT=NMAT+1
  824. ENDIF
  825.  
  826. ELSEIF (LESFOR(1).EQ.'DIFFUSION' ) THEN
  827. C +-------------------------------------------+
  828. C | FORMULATION DIFFUSION : 'ISOTROPE' 'FICK' |
  829. C +-------------------------------------------+
  830. IPROP = 3
  831. IF (IDIM.EQ.1) IPROP = 1
  832. CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1))
  833. IF (IPLAC.EQ.0) THEN
  834. DO i=NMAT,1,-1
  835. LESPRO(i+1)=LESPRO(i)
  836. ENDDO
  837. LESPRO(1)='ISOTROPE'
  838. NMAT=NMAT+1
  839. ENDIF
  840. CALL MODDIF(MOPROP,NMOD)
  841. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
  842. IF (IPLAC.EQ.0) THEN
  843. NMAT=NMAT+1
  844. LESPRO(NMAT)='FICK'
  845. ENDIF
  846.  
  847. C Ajout du mot 'FICK' si besoin avec 'ADVECTION'
  848. CALL PLACE(LESPRO,nmat,iplac,'ADVECTION')
  849. if(iplac .gt. 0) then
  850. NMAT=NMAT+1
  851. LESPRO(NMAT)='FICK'
  852. endif
  853.  
  854. ELSEIF (LESFOR(1).EQ.'CONTACT' ) THEN
  855. C +----------------------------------+
  856. C | FORMULATION CONTACT : UNILATERAL |
  857. C +----------------------------------+
  858. call place ( moprop,2,iplac,lespro(1))
  859. if( iplac.eq.0) then
  860. do iur=1,nmat
  861. lespro(nmat+2-iur)=lespro (nmat +1-iur)
  862. enddo
  863. lespro(1)='UNILATERAL'
  864. nmat=nmat+1
  865. endif
  866.  
  867. ELSEIF (LESFOR(1).EQ.'CONTRAINTE' ) THEN
  868. C +----------------------------------+
  869. C | FORMULATION CONTRAINTE |
  870. C +----------------------------------+
  871. call place ( moprop,3,iplac,lespro(1))
  872. if (iplac.eq.0) then
  873. do iur=1,nmat
  874. lespro(nmat+2-iur)=lespro (nmat +1-iur)
  875. enddo
  876. lespro(1)='CINEMATIQUE'
  877. nmat=nmat+1
  878. endif
  879. ENDIF
  880.  
  881. ELSE
  882. C si NMAT=0 on met le premier mot autorise
  883. NMAT = 1
  884. LESPRO(1)= MOPROP(1)
  885.  
  886. IF (LESFOR(1).EQ.'CHARGEMENT') THEN
  887. C +------------------------------------------------------------------+
  888. C | Defaut pour une FORMULATION CHARGEMENT : PAS DE CHOIX PAR DEFAUT |
  889. C +------------------------------------------------------------------+
  890. C L'UTILISATEUR DOIT SPECIFIER D'AUTRES MOT CLES APRES 'CHARGEMENT'
  891. CALL ERREUR(251)
  892. RETURN
  893.  
  894. ELSEIF(LESFOR(1).EQ.'THERMIQUE') THEN
  895. C +----------------------------------------------------+
  896. C | Defaut pour une FORMULATION THERMIQUE : CONDUCTION |
  897. C +----------------------------------------------------+
  898. NMAT = NMAT+1
  899. LESPRO(NMAT)='CONDUCTION'
  900.  
  901. ELSEIF (LESFOR(1).EQ.'MECANIQUE'.OR.
  902. & LESFOR(1).EQ.'POREUX' .OR.
  903. & LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  904. C +------------------------------------------------------------------------------+
  905. C | Defaut pour une FORMULATION MECANIQUE, POREUX ou MAGNETODYNAMIQUE : ISOTROPE |
  906. C +------------------------------------------------------------------------------+
  907. NMAT=NMAT+1
  908. LESPRO(NMAT)='ISOTROPE'
  909.  
  910. ELSEIF (LESFOR(1).EQ.'DIFFUSION') THEN
  911. C +----------------------------------------------+
  912. C | Defaut pour une FORMULATION DIFFUSION : FICK |
  913. C +----------------------------------------------+
  914. NMAT = NMAT+1
  915. LESPRO(NMAT)='FICK'
  916.  
  917. ELSEIF (LESFOR(1).EQ.'NAVIER_STOKES'.OR.
  918. & LESFOR(1).EQ.'EULER') THEN
  919. C +----------------------------------------------------------------+
  920. C | Defaut pour une FORMULATION NAVIER_STOKES OU EULER : NEWTONIEN |
  921. C +----------------------------------------------------------------+
  922. NMAT = 1
  923. LESPRO(NMAT)='NEWTONIEN'
  924.  
  925. ELSEIF (LESFOR(1).EQ.'FISSURE') THEN
  926. C +-------------------------------------+
  927. C | Defaut pour une FORMULATION FISSURE |
  928. C +-------------------------------------+
  929. NMAT = 3
  930. LESPRO(1)='MASS'
  931. LESPRO(2)='PARF'
  932. LESPRO(3)='POISEU_BLASIUS'
  933.  
  934. ELSEIF(LESFOR(1).EQ.'CONTACT') THEN
  935. C +---------------------------------------------------+
  936. C | Defaut pour une FORMULATION CONTACT : UNILATERAL |
  937. C +---------------------------------------------------+
  938. NMAT=1
  939. LESPRO(1)='UNILATERAL'
  940.  
  941. ELSEIF(LESFOR(1).EQ.'CONTRAINTE') THEN
  942. C +---------------------------------------------------+
  943. C | Defaut pour une FORMULATION CONTRAINTE |
  944. C +---------------------------------------------------+
  945. NMAT=1
  946. LESPRO(1)='CINEMATIQUE'
  947. ENDIF
  948. ENDIF
  949.  
  950. IF(LESFOR(1).EQ.'CHANGEMENT_PHASE' ) THEN
  951. C +------------------------------------------------------------------------+
  952. C | FORMULATION CHANGEMENT_PHASE : LECTURE DES INCONNUES PRIMALES & DUALES |
  953. C +------------------------------------------------------------------------+
  954. CALL LIRMOT(MOINCO,NBDIF,IPLAC,0)
  955. IF (IPLAC.EQ.0) THEN
  956. CALL ERREUR(1093)
  957. RETURN
  958.  
  959. ELSE
  960. IF (LESPRO(1)(1:10).EQ.'PARFAIT ') THEN
  961. JGM=2
  962. ELSEIF (LESPRO(1)(1:10).EQ.'SOLUBILITE') THEN
  963. JGM=4
  964. ELSE
  965. CALL ERREUR(5)
  966. ENDIF
  967. JGN =LOCOMP
  968. SEGINI,MLMOT1
  969. IPRIDU=MLMOT1
  970. DO IMOT=1,JGM
  971. CALL LIRCHA(MOPRID,1,ILONG)
  972. IF (IERR.NE.0) RETURN
  973. MLMOT1.MOTS(IMOT) = MOPRID
  974. ENDDO
  975. ENDIF
  976. ENDIF
  977.  
  978. 43 CONTINUE
  979. C Lecture eventuelle des types d'ELEMENTS FINIS a utiliser
  980. ITEF=0
  981. C=DEB==== FORMULATION HHO ==== Cas particulier =========================
  982. CALL LIRMOT(mcHHO,NMHHO,iHHO,0)
  983. IF (IERR.NE.0) RETURN
  984. IF (iHHO.NE.0) THEN
  985. CALL REFUS
  986. CALL LIRCHA(chaHHO,1,IRETI)
  987. IF (IERR.NE.0) RETURN
  988. loHHO = .TRUE.
  989. END IF
  990. C=FIN==== FORMULATION HHO ==============================================
  991. IF (NBTEF.EQ.0) GOTO 2
  992. C WRITE(*,*) 'MODELI:',(MOTEF(i),':',i=1,NBTEF)
  993. CALL MESLIR(-178)
  994. 1 CONTINUE
  995. CALL LIRMOT(MOTEF,NBTEF,LETEF,0)
  996. IF (IERR.NE.0) RETURN
  997. IF (LETEF.EQ.0) GOTO 2
  998. ITEF=ITEF+1
  999. LESTEF(ITEF)=MOTEF(LETEF)
  1000. if (ITEF.eq.1.and.lesfor(1).eq.'NAVIER_STOKES') goto 2
  1001. CALL MESLIR(-177)
  1002. GOTO 1
  1003.  
  1004. 2 CONTINUE
  1005. c Lecture eventuelle de listmots
  1006. jlmot1 = 0
  1007. jlmot2 = 0
  1008. CALL LIROBJ('LISTMOTS',jlmot1,0,iret)
  1009. if (ierr.ne.0) return
  1010. if (jlmot1.gt.0) then
  1011. call lirobj('LISTMOTS',jlmot2,1,iret)
  1012. if (ierr.ne.0) return
  1013. mlmot5 = jlmot1
  1014. mlmot6 = jlmot2
  1015. segact,mlmot5,mlmot6
  1016. if (mlmot5.mots(/2).ne.mlmot6.mots(/2)) then
  1017. call erreur(26)
  1018. return
  1019. endif
  1020. endif
  1021.  
  1022. C lecture pour mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
  1023. C En formulations 'MECANIQUE' et 'POREUX' : detection d'une loi non
  1024. C lineaire externe, le cas echeant saisie de donnees complementaires.
  1025. C Caracterisation : loi non lineaire externe si
  1026. C - famille 'VISCO_EXTERNE' ou
  1027. C - famille 'NON_LINEAIRE', materiau 'UTILISATEUR'.
  1028. C si pas loi externe lecture eventuelle des parametres externes
  1029. LMEEXT=.FALSE.
  1030. LMEVIX=.FALSE.
  1031. LMENLX=.FALSE.
  1032. LMENUM = 0
  1033. LMENOM = ' '
  1034. LMELIB = ' '
  1035. LMEFCT = ' '
  1036. LMELGB = 0
  1037. LMELGT = 0
  1038. LMELOI = 0
  1039. LMEPTR = 0
  1040.  
  1041. IF ( (NFOR.EQ.1).AND.
  1042. & (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') ) THEN
  1043. DO i=1,NMAT
  1044. IF (LESPRO(i).EQ.'VISCO_EXTERNE') THEN
  1045. LMEVIX=.TRUE.
  1046. GOTO 203
  1047. ENDIF
  1048. ENDDO
  1049.  
  1050. IF (.NOT.LMEVIX) THEN
  1051. DO i=1,NMAT
  1052. IF (LESPRO(i).EQ.'UTILISATEUR') THEN
  1053. LMENLX = .TRUE.
  1054. GOTO 203
  1055. ENDIF
  1056. ENDDO
  1057. ENDIF
  1058. C........N.B. LMEEXT exprime la condition (NFOR.EQ.1) ET
  1059. C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
  1060. 203 LMEEXT = LMEVIX.OR.LMENLX
  1061. IF ( LMEEXT ) THEN
  1062. C lecture et verif des noms des materiaux, des
  1063. C noms des variables internes, des noms des parametre externe pour
  1064. C loi externes
  1065. 210 CALL LIRMOT(MOEXT,NBEXT,LEXT,0)
  1066. C Si on ne trouve plus l'un des mots cles attendus, on sort
  1067. IF (LEXT.EQ.0) GOTO 211
  1068. C Lecture d'un entier sous 'NUME_LOI'
  1069. IF (LEXT.EQ.1) THEN
  1070. CALL LIRENT(LMENUM,1,IRET)
  1071. IF (IERR.NE.0) RETURN
  1072. C Valeur illicite du numero de la loi (superieur ou egal a 1)
  1073. IF (LMENUM.LT.1 .OR. LMENUM.GE.1000000) THEN
  1074. INTERR(1) = LMENUM
  1075. CALL ERREUR(36)
  1076. CALL ERREUR(947)
  1077. RETURN
  1078. ENDIF
  1079. C Lecture du nom de la loi sous 'NOM_LOI'
  1080. ELSE IF (LEXT.EQ.2) THEN
  1081. MOTEMP = ' '
  1082. CALL LIRCHA(MOTEMP,1,IRET)
  1083. IF (IERR.NE.0) RETURN
  1084. IRET = LONG(MOTEMP(1:IRET))
  1085. IF (IRET.GT.16) THEN
  1086. INTERR(1) = IRET
  1087. MOTERR = MOTEMP(1:IRET)
  1088. CALL ERREUR(-2)
  1089. CALL ERREUR(21)
  1090. RETURN
  1091. ELSE IF (IRET.LE.0) THEN
  1092. INTERR(1) = 0
  1093. MOTERR = 'NOM_LOI'
  1094. CALL ERREUR(-2)
  1095. CALL ERREUR(6)
  1096. RETURN
  1097. ENDIF
  1098. LMENOM = ' '
  1099. LMENOM(1:IRET) = MOTEMP(1:IRET)
  1100. C Lecture d'un objet LISTMOTS sous 'PARA_LOI'
  1101. ELSE IF (LEXT.EQ.3) THEN
  1102. CALL LIROBJ('LISTMOTS',LUPARX,1,IRET)
  1103. IF (IERR.NE.0) RETURN
  1104. C Lecture d'un objet LISTMOTS sous 'C_MATERIAU'
  1105. ELSE IF (LEXT.EQ.4) THEN
  1106. CALL LIROBJ('LISTMOTS',LUCMAT,1,IRET)
  1107. IF (IERR.NE.0) RETURN
  1108. C Lecture d'un objet LISTMOTS sous 'C_VARINTER'
  1109. ELSE IF (LEXT.EQ.5) THEN
  1110. CALL LIROBJ('LISTMOTS',LUCVAR,1,IRET)
  1111. IF (IERR.NE.0) RETURN
  1112. C Lecture du nom (du fichier) de la bibliotheque de la loi
  1113. ELSE IF (LEXT.EQ.6) THEN
  1114. MOTEMP = ' '
  1115. CALL LIRCHA(MOTEMP,1,IRET)
  1116. IF (IERR.NE.0) RETURN
  1117. IF (IRET.GT.LOCHAI) THEN
  1118. CALL ERREUR(1110)
  1119. RETURN
  1120. ENDIF
  1121. IRET = LONG(MOTEMP(1:IRET))
  1122. IF (IRET.LE.0) THEN
  1123. INTERR(1) = 0
  1124. MOTERR = 'LIB_LOI'
  1125. CALL ERREUR(-2)
  1126. CALL ERREUR(6)
  1127. RETURN
  1128. END IF
  1129. LMELIB = ' '
  1130. LMELIB(1:IRET) = MOTEMP(1:IRET)
  1131. LMELGB = IRET
  1132. LMEPTR = IRET
  1133. C Lecture du nom de la fonction de la loi
  1134. ELSE IF (LEXT.EQ.7) THEN
  1135. MOTEMP = ' '
  1136. CALL LIRCHA(MOTEMP,1,IRET)
  1137. IF (IERR.NE.0) RETURN
  1138. IF (IRET.GT.LOCHAI) THEN
  1139. CALL ERREUR(1110)
  1140. RETURN
  1141. ENDIF
  1142. IRET = LONG(MOTEMP(1:IRET))
  1143. IF (IRET.LE.0) THEN
  1144. INTERR(1) = 0
  1145. MOTERR = 'FCT_LOI'
  1146. CALL ERREUR(-2)
  1147. CALL ERREUR(6)
  1148. RETURN
  1149. ENDIF
  1150. LMEFCT = ' '
  1151. LMEFCT(1:IRET) = MOTEMP(1:IRET)
  1152. LMELGT = IRET
  1153. ENDIF
  1154. C On repete jusqu'a ce qu'on ne trouve plus aucun des
  1155. C mots cles attendus, regle de surcharge le cas echeant
  1156. GOTO 210
  1157. 211 CONTINUE
  1158. C...........Verifications sur les donnees
  1159. C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire)
  1160. IF (LMENUM.EQ.0 .AND. LMENOM.EQ.' ') THEN
  1161. IF (LMELGT.EQ.0) THEN
  1162. CALL ERREUR(641)
  1163. RETURN
  1164. ENDIF
  1165. ENDIF
  1166. IF (LMENUM.NE.0 .AND. LMENOM.NE.' ') THEN
  1167. MOTERR(1:16) = 'NUME_LOINOM_LOI '
  1168. CALL ERREUR(135)
  1169. RETURN
  1170. ENDIF
  1171. C Les liste des composantes ne doivent pas etre vides.
  1172. DO i = 1, 3
  1173. IF (i.EQ.1) mlmots = LUPARX
  1174. IF (i.EQ.2) mlmots = LUCMAT
  1175. IF (i.EQ.3) mlmots = LUCVAR
  1176. IF (mlmots.NE.0) THEN
  1177. SEGACT,mlmots
  1178. NBCOMP = mlmots.mots(/2)
  1179. IF (NBCOMP.EQ.0) THEN
  1180. CALL ERREUR(964)
  1181. RETURN
  1182. ENDIF
  1183. ENDIF
  1184. ENDDO
  1185. C Dans le cas d'un modele NON_LINEAIRE UTILISATEUR, on rajoute en fin de
  1186. C liste des proprietes du modele, le numero ou le nom de la loi attribue
  1187. C par l'utilisateur.
  1188. NMAT = NMAT + 1
  1189. LESPRO(NMAT) = ' '
  1190. IF (LMENUM.EQ.0) THEN
  1191. LESPRO(NMAT) = LMENOM
  1192. IF (LMELGT.GT.0 .AND. LMENOM.EQ.' ') THEN
  1193. c* On espere mettre un numero "unique" dans le nom !
  1194. SEGINI,limode
  1195. WRITE(LESPRO(NMAT)(1:16),'(I16)') limode
  1196. SEGSUP,limode
  1197. ENDIF
  1198. ELSE
  1199. WRITE(LESPRO(NMAT)(1:16),'(I16)') LMENUM
  1200. ENDIF
  1201. C Verifications pour une loi 'NON_LINEAIRE' 'UTILISATEUR'
  1202. IF ( LMENLX ) THEN
  1203. C Il manque les composantes materielles sous 'C_MATERIAU'
  1204. IF (LUCMAT.EQ.0) THEN
  1205. CALL ERREUR(641)
  1206. RETURN
  1207. ENDIF
  1208. C La liste des composantes materielles saisie sous
  1209. C 'C_MATERIAU' ne doit pas etre vide
  1210. MLMOTS=LUCMAT
  1211. SEGACT,MLMOTS
  1212. NBCOMP = MOTS(/2)
  1213. IF (NBCOMP.EQ.0) THEN
  1214. CALL ERREUR(964)
  1215. RETURN
  1216. ENDIF
  1217. ENDIF
  1218. C Dans le cas d'une libraire externe, quelques verifications puis
  1219. C recherche du pointeur de la fonction externe
  1220. IF (LMEPTR.GT.0) THEN
  1221. C Si le nom de la fonction n'a pas ete fourni avec le mot-cle 'FCT_LOI',
  1222. C on le construit a partir de 'NOM_LOI' ou 'NUME_LOI'.
  1223. IF (LMELGT.EQ.0) THEN
  1224. LMEFCT = ' '
  1225. IF (LMENUM.EQ.0) THEN
  1226. IRET = LONG(LMENOM)
  1227. LMEFCT(1:IRET) = LMENOM(1:IRET)
  1228. LMELGT = IRET
  1229. ELSE
  1230. IRET = 0
  1231. DO i = 1, 16
  1232. IRET = IRET + 1
  1233. IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 220
  1234. ENDDO
  1235. 220 continue
  1236. LMEFCT = 'umat_'//LESPRO(NMAT)(IRET:16)
  1237. LMELGT = 22-IRET
  1238. ENDIF
  1239. ENDIF
  1240. ip = -1
  1241. CALL LEXTOP(LMELIB,LMEFCT,ip,LMELOI,LMEPTR)
  1242. *** IF (IERR.NE.0) RETURN
  1243. *si pas d'erreur LMELOI > 0 et LMEPTR >0 pointe sur une fonction
  1244. *dbg IF (LMELOI.LE.0) CALL ERREUR(5)
  1245. *dbg IF (LMEPTR.LE.0) CALL ERREUR(5)
  1246. LMELGB = LONG(LMELIB)
  1247. LMELGT = LONG(LMEFCT)
  1248. *dbg write(ioimp,*) 'LMELOI =',LMELOI,LMEPTR,LMELGB,LMELGT,
  1249. *dbg & LMELIB(1:LMELGB),'=',LMEFCT(1:LMELGT)
  1250. ENDIF
  1251. ELSE
  1252. C si pas lois externes lecture des noms des parametres externes
  1253. CALL LIRMOT(MOEXT(2),1,LEXT,0)
  1254. IF (LEXT.NE.0) THEN
  1255. CALL LIROBJ('LISTMOTS',luparx,1,iret)
  1256. IF (IERR.NE.0) RETURN
  1257. ENDIF
  1258. ENDIF
  1259. C Verifications sur les parametres, si declares
  1260. IF (luparx.GT.0) THEN
  1261. C Si la temperature 'T ' fait partie des parametres de
  1262. C la loi, elle doit etre declaree en tete
  1263. mlmots=luparx
  1264. SEGACT,MLMOTS
  1265. NBPARA=MOTS(/2)
  1266. IF (NBPARA.GT.0) THEN
  1267. DO IP = 1, NBPARA
  1268. IF (MOTS(IP).EQ.'T ') THEN
  1269. IF (IP.GT.1) THEN
  1270. CALL ERREUR(948)
  1271. RETURN
  1272. ENDIF
  1273. GOTO 221
  1274. ENDIF
  1275. ENDDO
  1276. 221 CONTINUE
  1277. ENDIF
  1278. C Pas de parametres redondants
  1279. IF (NBPARA.GT.1) THEN
  1280. DO 230 IP1 = 1, NBPARA-1
  1281. PAR1 = MOTS(IP1)
  1282. DO 231 IP2 = IP1+1, NBPARA
  1283. IF (MOTS(IP2).EQ.PAR1) THEN
  1284. CALL ERREUR(949)
  1285. RETURN
  1286. ENDIF
  1287. 231 CONTINUE
  1288. 230 CONTINUE
  1289. ENDIF
  1290. ENDIF
  1291. ENDIF
  1292. C fin lecture mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
  1293.  
  1294. C Formulation 'DIFFUSION' : oooooooooooooooooooooooooooooooooooooooooooo
  1295. C - Detection d'une loi non lineaire externe (mot-cle 'UTILISATEUR')
  1296. C - Detection de la quantite de l'effet Soret (mot-cle 'SORET')
  1297. C - Lecture de l'inconnue "diffusant" (mot-cle 'INCO')
  1298. C 3 CONTINUE
  1299. LDIEXT = .FALSE.
  1300. LDISOR = .FALSE.
  1301. LDINUM = 0
  1302. LDINOM = ' '
  1303. LDILIB = ' '
  1304. LDIFCT = ' '
  1305. LDILGB = 0
  1306. LDILGT = 0
  1307. LDILOI = 0
  1308. LDIPTR = 0
  1309. IF (NFOR.EQ.1 .AND. LESFOR(1).EQ.'DIFFUSION') THEN
  1310. C -- Recherche des informations sur la presence d'une loi externe --
  1311. DO i=1,NMAT
  1312. LDIEXT = LESPRO(i).EQ.'UTILISATEUR'
  1313. LDISOR = LESPRO(i).EQ.'SORET'
  1314. ENDDO
  1315. C - Lecture des informations pour la loi externe
  1316. IF (LDIEXT) THEN
  1317. 310 CONTINUE
  1318. CALL LIRMOT(MOEXT,NBEXT,LEXT,0)
  1319. IF (LEXT.EQ.0) GOTO 311
  1320. C Lecture d'un entier sous 'NUME_LOI'
  1321. IF (LEXT.EQ.1) THEN
  1322. CALL LIRENT(LDINUM,1,IRET)
  1323. IF (IERR.NE.0) RETURN
  1324. IF (LDINUM.LT.1 .OR. LDINUM.GE.1000000) THEN
  1325. INTERR(1) = LDINUM
  1326. CALL ERREUR(36)
  1327. CALL ERREUR(947)
  1328. RETURN
  1329. ENDIF
  1330. C Lecture du nom de la loi sous 'NOM_LOI'
  1331. ELSE IF (LEXT.EQ.2) THEN
  1332. MOTEMP = ' '
  1333. CALL LIRCHA(MOTEMP,1,IRET)
  1334. IF (IERR.NE.0) RETURN
  1335. IRET = LONG(MOTEMP(1:IRET))
  1336. IF (IRET.GT.16) THEN
  1337. INTERR(1) = IRET
  1338. MOTERR = MOTEMP(1:IRET)
  1339. CALL ERREUR(-2)
  1340. CALL ERREUR(21)
  1341. RETURN
  1342. ELSE IF (IRET.LE.0) THEN
  1343. INTERR(1) = IRET
  1344. MOTERR = 'NOM_LOI'
  1345. CALL ERREUR(-2)
  1346. CALL ERREUR(6)
  1347. RETURN
  1348. ENDIF
  1349. LDINOM = ' '
  1350. LDINOM(1:IRET) = MOTEMP(1:IRET)
  1351. C Lecture d'un objet LISTMOTS sous 'PARA_LOI'
  1352. ELSE IF (LEXT.EQ.3) THEN
  1353. CALL LIROBJ('LISTMOTS',luparx,1,IRET)
  1354. IF (IERR.NE.0) RETURN
  1355. C Lecture d'un objet LISTMOTS sous 'C_MATERIAU'
  1356. ELSE IF (LEXT.EQ.4) THEN
  1357. CALL LIROBJ('LISTMOTS',lucmat,1,IRET)
  1358. IF (IERR.NE.0) RETURN
  1359. C Lecture d'un objet LISTMOTS sous 'C_VARINTER'
  1360. ELSE IF (LEXT.EQ.5) THEN
  1361. CALL LIROBJ('LISTMOTS',lucvar,1,IRET)
  1362. IF (IERR.NE.0) RETURN
  1363. C Lecture du nom (du fichier) de la bibliotheque de la loi
  1364. ELSE IF (LEXT.EQ.6) THEN
  1365. MOTEMP = ' '
  1366. CALL LIRCHA(MOTEMP,1,IRET)
  1367. IF (IERR.NE.0) RETURN
  1368. IF (IRET.GT.LOCHAI) THEN
  1369. CALL ERREUR(1110)
  1370. RETURN
  1371. ENDIF
  1372. IRET = LONG(MOTEMP(1:IRET))
  1373. IF (IRET.LE.0) THEN
  1374. INTERR(1) = IRET
  1375. MOTERR = MOTEMP
  1376. CALL ERREUR(-2)
  1377. CALL ERREUR(6)
  1378. RETURN
  1379. ENDIF
  1380. LDILIB = ' '
  1381. LDILIB(1:IRET) = MOTEMP(1:IRET)
  1382. LDILGB = IRET
  1383. LDIPTR = IRET
  1384. C Lecture du nom de la fonction de la loi
  1385. ELSE IF (LEXT.EQ.7) THEN
  1386. MOTEMP = ' '
  1387. CALL LIRCHA(MOTEMP,1,IRET)
  1388. IF (IERR.NE.0) RETURN
  1389. IF (IRET.GT.LOCHAI) THEN
  1390. CALL ERREUR(1110)
  1391. RETURN
  1392. ENDIF
  1393. IRET = LONG(MOTEMP(1:IRET))
  1394. IF (IRET.LE.0) THEN
  1395. INTERR(1) = IRET
  1396. MOTERR = MOTEMP
  1397. CALL ERREUR(-2)
  1398. CALL ERREUR(6)
  1399. RETURN
  1400. ENDIF
  1401. LDIFCT(1:IRET) = MOTEMP(1:IRET)
  1402. LDILGT = IRET
  1403. ENDIF
  1404. GOTO 310
  1405. 311 CONTINUE
  1406. C Verifications des informations obligatoires de la loi externe
  1407. C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire)
  1408. IF (LDINUM.EQ.0 .AND. LDINOM.EQ.' ') THEN
  1409. if (LDILGT.eq.0) then
  1410. CALL ERREUR(641)
  1411. RETURN
  1412. endif
  1413. ENDIF
  1414. IF (LDINUM.NE.0 .AND. LDINOM.NE.' ') THEN
  1415. MOTERR(1:16) = 'NUME_LOINOM_LOI '
  1416. CALL ERREUR(135)
  1417. RETURN
  1418. ENDIF
  1419. C Il manque la liste 'C_MATERIAU'
  1420. IF (lucmat.EQ.0) THEN
  1421. CALL ERREUR(641)
  1422. RETURN
  1423. ENDIF
  1424. C Les liste des composantes ne doivent pas etre vides.
  1425. DO i = 1, 3
  1426. IF (i.EQ.1) MLMOTS = luparx
  1427. IF (i.EQ.2) MLMOTS = lucmat
  1428. IF (i.EQ.3) MLMOTS = lucvar
  1429. IF (MLMOTS.NE.0) THEN
  1430. SEGACT,MLMOTS
  1431. NBCOMP = MOTS(/2)
  1432. IF (NBCOMP.EQ.0) THEN
  1433. CALL ERREUR(964)
  1434. RETURN
  1435. ENDIF
  1436. ENDIF
  1437. ENDDO
  1438. C Dans le cas d'un modele UTILISATEUR, on rajoute en fin de
  1439. C liste des proprietes du modele, le numero attribue par l'utilisateur.
  1440. NMAT = NMAT + 1
  1441. LESPRO(NMAT) = ' '
  1442. IF (LDINUM.EQ.0) THEN
  1443. LESPRO(NMAT) = LDINOM
  1444. if (LDILGT.gt.0.and.LDINOM.eq.' ') then
  1445. c* On espere mettre un numero "unique" dans le nom !
  1446. segini,limode
  1447. write(LESPRO(NMAT)(1:16),'(I16)') limode
  1448. segsup,limode
  1449. endif
  1450. ELSE
  1451. WRITE(LESPRO(NMAT)(1:16),'(I16)') LDINUM
  1452. ENDIF
  1453. C Dans le cas d'une libraire externe, quelques verifications puis
  1454. C recherche du pointeur de la fonction externe
  1455. IF (LDIPTR.GT.0) THEN
  1456. C Si le nom de la fonction n'a pas ete fourni avec le mot-cle 'FCT_LOI',
  1457. C on le construit a partir de 'NOM_LOI' ou 'NUME_LOI'.
  1458. IF (LDILGT.EQ.0) THEN
  1459. LDIFCT = ' '
  1460. IF (LDINUM.EQ.0) THEN
  1461. IRET = LONG(LDINOM)
  1462. LDIFCT(1:IRET) = LDINOM(1:IRET)
  1463. LDILGT = IRET
  1464. ELSE
  1465. IRET = 0
  1466. DO i = 1, 16
  1467. IRET = IRET + 1
  1468. IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 320
  1469. ENDDO
  1470. 320 CONTINUE
  1471. LDIFCT = 'umat_'//LESPRO(NMAT)(IRET:16)
  1472. LDILGT = 22-IRET
  1473. ENDIF
  1474. ENDIF
  1475. ip = -1
  1476. CALL LEXTOP(LDILIB,LDIFCT,ip,LDILOI,LDIPTR)
  1477. IF (IERR.NE.0) RETURN
  1478. *si pas d'erreur LDILOI > 0 et LDIPTR >0 pointe sur une fonction
  1479. *dbg IF (LDILOI.LE.0) CALL ERREUR(5)
  1480. *dbg IF (LDIPTR.LE.0) CALL ERREUR(5)
  1481. LDILGB = LONG(LDILIB)
  1482. LDILGT = LONG(LDIFCT)
  1483. ENDIF
  1484. ENDIF
  1485. C - Lecture des informations pour la loi Soret :
  1486. C - quantite dont le gradient est l'origine de l'effet ('T' par defaut)
  1487. IF (LDISOR) THEN
  1488. mlmots = 0
  1489. CHARIN = 'T '
  1490. C Lecture du mot-cle 'PARA_LOI' et donnees associees
  1491. CALL LIRMOT(MOEXT(2),1,LEXT,0)
  1492. IF (IERR.NE.0) RETURN
  1493. IF (LEXT.EQ.1) THEN
  1494. CALL LIROBJ('LISTMOTS',mlmots,0,IRET)
  1495. IF (IERR.NE.0) RETURN
  1496. IF (IRET.EQ.0) THEN
  1497. CALL LIRCHA(CHARIN,1,IRETI)
  1498. IF (IERR.NE.0) RETURN
  1499. IRETI=LONG(CHARIN)
  1500. IF (IRETI.EQ.0) CALL ERREUR(643)
  1501. ELSE
  1502. SEGACT,mlmots
  1503. NBCOMP = mots(/2)
  1504. IF (NBCOMP.EQ.0) THEN
  1505. CALL ERREUR(964)
  1506. ELSE
  1507. CHARIN = MOTS(1)
  1508. IRETI = LONG(CHARIN)
  1509. IF (IRETI.EQ.0) CALL ERREUR(643)
  1510. ENDIF
  1511. ENDIF
  1512. IF (IERR.NE.0) RETURN
  1513. IRETMA = 2
  1514. C*8 IRETMA = 6
  1515. IF (IRETI.GT.IRETMA) THEN
  1516. INTERR(1) = IRETMA
  1517. MOTERR(1:8) = CHARIN(1:IRETI)
  1518. CALL ERREUR(-353)
  1519. ENDIF
  1520. IRETI = MIN(IRETI,IRETMA)
  1521. CHARIN(IRETI+1:8) = ' '
  1522. ENDIF
  1523. JGM = 1
  1524. JGN = LOCOMP
  1525. SEGINI,mlmots
  1526. mots(1) = CHARIN
  1527. luparx = mlmots
  1528. ENDIF
  1529.  
  1530. C -- Pour la formulation DIFFUSION : lecture quantite (ddl) diffusant --
  1531. C -- On cherche a lire le mot 'INCO' suivi du nom de l'INCOnnue donne --
  1532. C -- soit par un LISTMOTS, soit par un MOT puis eventuellement du nom --
  1533. C -- de la grandeur DUALe donne par un objet de meme type que pour le --
  1534. C -- nom de l'inconnue. --
  1535. CALL LIRMOT(MOINCO,NBDIF,LEXT,0)
  1536. IF (LEXT.EQ.0) THEN
  1537. C*8 MDIINC='CONC '
  1538. C*8 MDIDUA='QCONC '
  1539. MDIINC='CO '
  1540. MDIDUA='QCO '
  1541. ELSE
  1542. MDIINC=' '
  1543. MDIDUA='Q '
  1544. CHARIN=' '
  1545. CHARRE=' '
  1546. CALL LIROBJ('LISTMOTS',mlmots,0,IRET)
  1547. IF (IERR.NE.0) RETURN
  1548. IF (mlmots.NE.0) THEN
  1549. SEGACT,mlmots
  1550. NBCOMP = MOTS(/2)
  1551. IF (NBCOMP.EQ.0) THEN
  1552. CALL ERREUR(643)
  1553. ELSE
  1554. CHARIN=MOTS(1)
  1555. IRETI=LONG(CHARIN)
  1556. IF (IRETI.EQ.0) CALL ERREUR(643)
  1557. ENDIF
  1558. IF (IERR.NE.0) RETURN
  1559. CALL LIROBJ('LISTMOTS',mlmots,0,IRETE)
  1560. IF (IERR.NE.0) RETURN
  1561. IF (mlmots.NE.0) THEN
  1562. SEGACT,mlmots
  1563. NBCOMP = MOTS(/2)
  1564. IF (NBCOMP.EQ.0) THEN
  1565. CALL ERREUR(643)
  1566. ELSE
  1567. CHARRE=MOTS(1)
  1568. IRETE=LONG(CHARRE)
  1569. IF (IRETE.EQ.0) CALL ERREUR(643)
  1570. ENDIF
  1571. IF (IERR.NE.0) RETURN
  1572. ENDIF
  1573.  
  1574. ELSE
  1575. CALL LIRCHA(CHARIN,1,IRETI)
  1576. IF (IERR.NE.0) RETURN
  1577. IRETI = LONG(CHARIN(1:IRETI))
  1578. IF (IRETI.EQ.0) THEN
  1579. CALL ERREUR(643)
  1580. RETURN
  1581. ENDIF
  1582. CALL LIRCHA(CHARRE,0,IRETE)
  1583. IF (IERR.NE.0) RETURN
  1584. IF (IRETE.GT.0) THEN
  1585. IRETE = LONG(CHARRE(1:IRETE))
  1586. IF (IRETE.EQ.0) THEN
  1587. CALL ERREUR(643)
  1588. RETURN
  1589. ENDIF
  1590. ENDIF
  1591. ENDIF
  1592.  
  1593. IRETMA = 2
  1594. C*8 IRETMA = 6
  1595. IF (IRETI.GT.IRETMA) THEN
  1596. INTERR(1) = IRETMA
  1597. MOTERR(1:8) = CHARIN(1:IRETI)
  1598. CALL ERREUR(-353)
  1599. ENDIF
  1600. IRETI = MIN(IRETI,IRETMA)
  1601. MDIINC(1:IRETI)=CHARIN(1:IRETI)
  1602. IF (IRETE.EQ.0) THEN
  1603. MDIDUA(2:1+IRETI)=MDIINC(1:IRETI)
  1604.  
  1605. ELSE
  1606. IRETMA = IRETMA + 2
  1607. IF (IRETE.GT.IRETMA) THEN
  1608. INTERR(1) = IRETMA
  1609. MOTERR(1:8) = CHARRE(1:IRETE)
  1610. CALL ERREUR(-353)
  1611. ENDIF
  1612. IRETE=MIN(IRETE,IRETMA)
  1613. MDIDUA(1:IRETE)=CHARRE(1:IRETE)
  1614. ENDIF
  1615. ENDIF
  1616.  
  1617. c* Verification des noms de primale et duale lues
  1618. CALL VERMDI(MDIINC,MDIDUA)
  1619. IF (IERR.NE.0) RETURN
  1620.  
  1621. C On les place dans un LISTMOTS pour TYMODE et IVAMODE
  1622. JGN = LOCOMP
  1623. JGM = 2
  1624. SEGINI,MLMOT1
  1625. iplrdi=MLMOT1
  1626. MLMOT1.MOTS(1) = MDIINC
  1627. MLMOT1.MOTS(2) = MDIDUA
  1628. ENDIF
  1629. C Fin Formulation 'DIFFUSION' oooooooooooooooooooooooooooooooooooooooooo
  1630.  
  1631. C Lecture eventuelle du NOM de CONSTITUANT, du nombre de POINTs
  1632. C d'INTEGRATION, du point support pour les modes en DEFOrmations
  1633. C PLANEs GENEralisees, du nom de la phase, de la formulation non_locale
  1634. C fin des lecture en 22
  1635. 674 CONTINUE
  1636. kcons = 0
  1637. NGINT = 0
  1638. NGRIG = 0
  1639. NGMAS = 0
  1640. NGCON = 0
  1641. IPTGEN = 0
  1642. IPMOD1 = 0
  1643. klcon = 0
  1644. plicon = 0
  1645. ILIE = 0
  1646. INLOC = 0
  1647. INLVIA = 0
  1648. LULVIA = 0
  1649. kbnlin = 0
  1650. IPMOD3 = 0
  1651.  
  1652. 675 CONTINUE
  1653. CALL LIRMOT(MOCON,NBCON,LECON,0)
  1654. IF (LECON.EQ.0) GOTO 22
  1655. IF (LECON.EQ.1) THEN
  1656. CALL LIRCHA(CONM,1,kcons)
  1657. IF (IERR.NE.0) RETURN
  1658. ELSE IF (LECON.EQ.2) THEN
  1659. i1foi = 1
  1660. 677 continue
  1661. legaus=0
  1662. CALL LIRMOT(MGAUSS,4,legaus,0)
  1663. if (ierr.ne.0) return
  1664. if (i1foi.ne.1.and.legaus.eq.0) goto 675
  1665. CALL LIRENT(itt,1,iret)
  1666. if (ierr.ne.0) return
  1667. if (itt.lt.1) then
  1668. interr(1) = itt
  1669. call erreur(36)
  1670. return
  1671. endif
  1672. if (legaus.eq.0 .or. legaus.eq.1) then
  1673. c itt doit etre impair (> 0)
  1674. IF (MOD(itt,2).EQ.0) THEN
  1675. call erreur(607)
  1676. return
  1677. ENDIF
  1678. NGINT = itt
  1679. endif
  1680. if (legaus.eq.2) NGRIG = itt
  1681. if (legaus.eq.3) NGMAS = itt
  1682. if (legaus.eq.4) NGCON = itt
  1683. if (i1foi.eq.1.and.legaus.eq.0) goto 675
  1684. i1foi = 0
  1685. c INTE itt <=> INTE EPAI itt ; autres mots a ecrire
  1686. c Syntaxe de modeli non decrite :
  1687. c Si plusieurs mots de MGAUSS
  1688. c INTE MOT1 itt1 MOT2 itt2 ... ; (couples MOTi iiti obligatoires)
  1689. goto 677
  1690. ELSE IF (LECON.EQ.3) THEN
  1691. CALL LIROBJ('POINT',IPTGEN,1,IRET)
  1692. IF (IERR.NE.0) RETURN
  1693. C On transforme le point en maillage de POI1 (avec un seul element)
  1694. CALL CRELEM(IPTGEN)
  1695. C On verifie s'il n'a pas deja ete preconditionne.
  1696. CALL CRECH1(IPTGEN,1)
  1697. ELSE IF (LECON.EQ.4) THEN
  1698. CALL LIRCHA(PHAM,1,IRET)
  1699. IF (IERR.NE.0) RETURN
  1700. ELSE IF (LECON.EQ.5) THEN
  1701. NMAT = NMAT + 1
  1702. LESPRO(NMAT) = 'STATIONNAIRE'
  1703. if (iptabs.gt.0) then
  1704. else
  1705. CALL LIROBJ('MMODEL',IPMOD1,1,IRET)
  1706. IF (IERR.NE.0) RETURN
  1707. endif
  1708. C LCOI et LCOS : options non documentees pour le modele LIAISON !
  1709. C Lecture obligatoire du modele associe (sinon options sans interet)
  1710. ELSE IF (LECON.EQ.6.OR.LECON.EQ.7) THEN
  1711. IF (LESFOR(1).NE.'LIAISON') THEN
  1712. CALL ERREUR(251)
  1713. RETURN
  1714. ENDIF
  1715. CALL LIROBJ('MMODEL ',ipmod2,1,iret)
  1716. IF (IERR.NE.0) RETURN
  1717. CALL ACTOBJ('MMODEL ',ipmod2,1)
  1718. IF (IERR.NE.0) RETURN
  1719. mmode2 = ipmod2
  1720. n2 = mmode2.kmodel(/1)
  1721. if (n2.ne.1) then
  1722. write(ioimp,*) 'Liaison conditionnelle mal specifiee (1)'
  1723. call erreur(5)
  1724. return
  1725. endif
  1726. imode2 = mmode2.kmodel(1)
  1727. if (imode2.formod(1).ne.'LIAISON') THEN
  1728. write(ioimp,*) 'Liaison conditionnelle mal specifiee (2)'
  1729. call erreur(5)
  1730. return
  1731. endif
  1732. if (klcon.eq.0) then
  1733. nlcon = 10
  1734. segini plicon
  1735. endif
  1736. klcon = klcon + 1
  1737. if (klcon.gt.nlcon) then
  1738. nlcon = nlcon + 10
  1739. segadj plicon
  1740. endif
  1741. mlicon(klcon) = ipmod2
  1742. tlicon(klcon) = lecon
  1743. C (fdp) option 'LIE' pour les JOI1
  1744. ELSE IF (LECON.EQ.9) THEN
  1745. ILIE = 1
  1746. ELSE IF (LECON.EQ.10) THEN
  1747. IF (LESFOR(1).NE.'MECANIQUE'.AND.LESFOR(1).NE.'POREUX') THEN
  1748. CALL ERREUR(251)
  1749. RETURN
  1750. ENDIF
  1751. CALL MODNLO(MNLOCA,NLODIM)
  1752. IF (NLODIM.GT.NLOMAX) THEN
  1753. CALL ERREUR(6)
  1754. RETURN
  1755. ENDIF
  1756. CALL LIRMOT(MNLOCA,NLODIM,INLOC,1)
  1757. IF (IERR.NE.0) RETURN
  1758. CALL LIRMOT(MNLVAR,1,INLVIA,1)
  1759. IF (IERR.NE.0) RETURN
  1760. CALL LIROBJ('LISTMOTS',LULVIA,1,IRET)
  1761. IF (IERR.NE.0) RETURN
  1762. ELSE IF (LECON.GE.11.and.LECON.LE.13) THEN
  1763. if (kbnlin.eq.0) then
  1764. jgn = 4
  1765. JGM = 3
  1766. segini opnlin
  1767. endif
  1768. kbnlin = kbnlin + 1
  1769. opnlin.mots(kbnlin) = mocon(lecon)
  1770. ELSE IF (LECON.EQ.14) THEN
  1771. NMAT = NMAT + 1
  1772. LESPRO(NMAT) = 'COMPORTEMENT'
  1773. CALL LIROBJ('MMODEL',IPMOD3,1,IRET)
  1774. IF (IERR.NE.0) RETURN
  1775. ENDIF
  1776. GOTO 675
  1777.  
  1778. 22 CONTINUE
  1779. if (iptabm.gt.0.and.iptabs.eq.0.and.ipmod1.gt.0) goto 91
  1780.  
  1781. C========== ACTIVATION DU MAILLAGE POUR CONSTRUIRE MMODEL ==============
  1782. C Recuperation des caracteristiques du MAILLAGE dans MELEME
  1783. IF (IPGEOM .EQ. 0) THEN
  1784. MOTERR='MAILLAGE'
  1785. CALL ERREUR(471)
  1786. RETURN
  1787. ENDIF
  1788.  
  1789. CALL ACTOBJ('MAILLAGE',IPGEOM,1)
  1790. MELEME = IPGEOM
  1791. NSOU = MELEME.LISOUS(/1)
  1792. NSOU1 = MAX(1,NSOU)
  1793.  
  1794. C=DEB==== FORMULATION HHO ==== Premieres verifications =================
  1795. IPLHHO = 0
  1796. IF (loHHO) THEN
  1797. C= Pour l'instant, HHO en formulation MECANIQUE !
  1798. IF ( (NFOR.EQ.1 .AND. LESFOR(1).NE.'MECANIQUE') .OR.
  1799. & (NFOR.NE.1) ) THEN
  1800. write(ioimp,*) 'Formulation HHO --> MECANIQUE uniquement'
  1801. CALL ERREUR(251)
  1802. RETURN
  1803. END IF
  1804. IF ( .NOT. ( IFOMOD.EQ.-1 .AND. IFOUR.NE.-3) ) THEN
  1805. write(ioimp,*) 'Formulation HHO --> 2D PLAN DEFO/CONT'
  1806. c-dbg IF ( .NOT. ( (IFOMOD.EQ.2) .OR.
  1807. c-dbg & (IFOMOD.EQ.-1 .AND. IFOUR.NE.-3) ) ) THEN
  1808. c-dbg write(ioimp,*) 'Formulation HHO --> 2D PLAN DEFO/CONT or 3D'
  1809. CALL ERREUR(251)
  1810. RETURN
  1811. END IF
  1812. C=
  1813. CALL HHOPRE(CHAHHO,IPGEOM,IPLHHO,iret)
  1814. IF (iret.NE.0) THEN
  1815. CALL ERREUR(iret)
  1816. RETURN
  1817. ENDIF
  1818. END IF
  1819. C=FIN==== FORMULATION HHO ==============================================
  1820.  
  1821. C= PARTIE 2 ============================================================
  1822. C Initialisations et remplissage du segment MMODEL = IPMODE
  1823. C=======================================================================
  1824. c-dbg write(ioimp,*)
  1825. c-dbg write(ioimp,*) ' INITIALISATION MMODEL A ',NSOU1,' ZONE(S)'
  1826.  
  1827. N1 = NSOU1
  1828. * mmode2 sert a ranger la deuxieme partie du contact symetrique
  1829. SEGINI,MMODEL,mmode2
  1830. IPMODE = MMODEL
  1831.  
  1832. C Nom du constituant par defaut si non donne en entree
  1833. IF (kcons.EQ.0) WRITE(CONM,FMT='(I16)') IPMODE
  1834.  
  1835. C Determination de MN3 selon la formulation :
  1836. C Par defaut MN3 est fixe a 1.
  1837. MN3 = 1
  1838. IF (LESFOR(1).EQ.'NAVIER_STOKES ') THEN
  1839. MN3=2
  1840. C* NAVIER_STOKES + NLIN idem que MECANIQUE
  1841. IF (LESPRO(1).EQ.'NLIN ') MN3=12
  1842. ENDIF
  1843. IF (LESFOR(1).EQ.'EULER ') MN3=2
  1844. IF (LESFOR(1).EQ.'DARCY ') MN3=2
  1845. IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') MN3=12
  1846. IF (LESFOR(1).EQ.'THERMOHYDRIQUE ') MN3=12
  1847. IF (LESFOR(1).EQ.'METALLURGIE ') MN3=2
  1848. IF (LESFOR(1).EQ.'FISSURE ') MN3=2
  1849. IF (LESFOR(1).EQ.'MECANIQUE ' .OR.
  1850. & LESFOR(1).EQ.'POREUX ' .OR.
  1851. & LESFOR(1).EQ.'CHARGEMENT ' .OR.
  1852. & nfor.EQ.2 ) THEN
  1853. IF (INLOC.NE.0) THEN
  1854. MN3=14
  1855. ELSE
  1856. MN3=12
  1857. ENDIF
  1858. ENDIF
  1859. IF (LESFOR(1).EQ.'LIQUIDE ') MN3=12
  1860. IF (LESFOR(1).EQ.'LIAISON ') MN3=12
  1861. IF (LESFOR(1).EQ.'ELECTROSTATIQUE ') MN3=12
  1862. IF (LESFOR(1).EQ.'DIFFUSION ') MN3=12
  1863. IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') MN3=12
  1864. IF (LESFOR(1).EQ.'MELANGE ') MN3= 7
  1865. c-dbg write(ioimp,*) 'MN3 =',MN3,LESFOR(1),nfor
  1866.  
  1867. C- Determination de NOBMOD selon la formulation :
  1868. NOBMOD = 0
  1869. NOBMEC = 0
  1870. NOBDIF = 0
  1871. IF (LESFOR(1).EQ.'CONTACT ') THEN
  1872. c* IF (IFROCA.NE.0) NOBMOD = 2
  1873. c* IF (ifrtt .ne.0) NOBMOD = 1
  1874. NOBMOD = 3
  1875.  
  1876. ELSEIF (LESFOR(1).EQ.'CONTRAINTE') THEN
  1877. if (lactr.eq.1 .and. idim.ne.3) nobmod=3
  1878. if (lactr.eq.1 .and. idim.eq.3) nobmod=4
  1879. if (lactr.eq.2) nobmod=3
  1880.  
  1881. ELSEIF (LESFOR(1).EQ.'MECANIQUE ') THEN
  1882. IF (LESPRO(2)(1:8).EQ.'MODAL ') THEN
  1883. if (IPTMOD.GT.0) NOBMOD = 1
  1884. if (ipmod3.gt.0) nobmod = nobmod + 1
  1885. ENDIF
  1886. ELSEIF (LESFOR(1).EQ.'DIFFUSION ') THEN
  1887. NOBDIF = NOBMOD
  1888. NOBMOD = NOBMOD + 1
  1889. IF (LDILOI.GT.0) NOBMOD = NOBMOD + 4
  1890.  
  1891. C* Modeles UTILISATEUR en MECANIQUE :
  1892. ELSEIF (LMEEXT) THEN
  1893. NOBMEC = NOBMOD
  1894. IF (LMELOI.GT.0) NOBMOD = NOBMOD + 4
  1895. C IF (LMEVIX ) NOBMOD = NOBMOD + 2
  1896. IF (LMEVIX ) NOBMOD = NOBMOD + 1
  1897.  
  1898. ELSEIF (LESFOR(1).eq.'METALLURGIE ') THEN
  1899. C On rangera les pointeurs sur les ListMots Phases,
  1900. C Reactifs, Produits et Types de Reactions dans IVAMOD
  1901. NOBMOD = 4
  1902.  
  1903. ELSEIF (LESFOR(1).eq.'CHANGEMENT_PHASE') THEN
  1904.  
  1905. IF (LESPRO(1)(1:10).EQ.'PARFAIT ') THEN
  1906. C On rangera : -le LISTMOTS des inconnues primales et duales dedans
  1907. C -le MAILLAGE des MULTIPLICATEURS 'LX'
  1908. NOBMOD = 2
  1909. ELSEIF (LESPRO(1)(1:10).EQ.'SOLUBILITE') THEN
  1910. C On rangera : -le LISTMOTS des inconnues primales et duales dedans
  1911. C -le 1er MAILLAGE des MULTIPLICATEURS 'LX'
  1912. C -le 2eme MAILLAGE des MULTIPLICATEURS 'LX'
  1913. NOBMOD = 3
  1914. ELSE
  1915. CALL ERREUR(5)
  1916. ENDIF
  1917.  
  1918. ELSE IF (lesfor(1).eq.'NAVIER_STOKES ') THEN
  1919. IF (LESPRO(1).EQ.'NLIN ') NOBMOD = 1
  1920.  
  1921. ELSE IF (lesfor(1).eq.'THERMIQUE ') THEN
  1922. IF (IRAYE.eq.1) NOBMOD = 2*icavit+isyme*idim+ifacaf*4
  1923.  
  1924. C LIAISON conditionnelle
  1925. ELSE IF (LESFOR(1).EQ.'LIAISON ') THEN
  1926. c* if (klcon.gt.0) THEN
  1927. noblia = NOBMOD
  1928. NOBMOD = NOBMOD + klcon
  1929. c* endif
  1930. ENDIF
  1931.  
  1932. C=DEB==== FORMULATION HHO ==== Donnees supplementaires =================
  1933. IF (loHHO) THEN
  1934. nobHHO = NOBMOD
  1935. NOBMOD = NOBMOD + MTYHHO
  1936. END IF
  1937. C=FIN==== FORMULATION HHO ==============================================
  1938.  
  1939. IF (jlmot1.gt.0) THEN
  1940. if (nobmod.ne.0) then
  1941. write(ioimp,*) 'NOBMOD !=0 et jlmot1,jlmmot2 > 0'
  1942. call erreur(5)
  1943. return
  1944. endif
  1945. NOBMOD = 2
  1946. ENDIF
  1947.  
  1948. NOBMOD0 = NOBMOD
  1949. NOBMEC0 = NOBMEC
  1950. NOBDIF0 = NOBDIF
  1951. nobHHO0 = nobHHO
  1952. noblia0 = noblia
  1953.  
  1954. C***********************************************************************
  1955. C Boucle (10) sur les maillages elementaires de IPGEOM
  1956. C***********************************************************************
  1957. MELEME = IPGEOM
  1958. IPT1 = MELEME
  1959.  
  1960. DO 10 IM = 1, NSOU1
  1961.  
  1962. IF (NSOU.NE.0) IPT1 = MELEME.LISOUS(IM)
  1963. ITYP1 = IPT1.ITYPEL
  1964. NBNN = IPT1.NUM(/1)
  1965. NBEL = IPT1.NUM(/2)
  1966.  
  1967. C +--------------------------------------------------------------------+
  1968. C | Creation du modele elementaire IMODEL |
  1969. C +--------------------------------------------------------------------+
  1970. NOBMOD = NOBMOD0
  1971. NOBMEC = NOBMEC0
  1972. NOBDIF = NOBDIF0
  1973. nobHHO = nobHHO0
  1974. noblia = noblia0
  1975.  
  1976. SEGINI,IMODEL
  1977. mmodel.KMODEL(IM) = IMODEL
  1978.  
  1979. C +--------------------------------------------------------------------+
  1980. C | Remplissage du IMODEL |
  1981. C +--------------------------------------------------------------------+
  1982. imodel.IMAMOD = IPT1
  1983.  
  1984. imodel.CONMOD(1:16) = CONM
  1985. imodel.conmod(17:24) = PHAM
  1986.  
  1987. DO i = 1, NFOR
  1988. imodel.FORMOD(i) = LESFOR(i)
  1989. ENDDO
  1990. IF (NMAT.NE.0) THEN
  1991. DO i = 1, NMAT
  1992. imodel.MATMOD(i) = LESPRO(i)
  1993. ENDDO
  1994. ENDIF
  1995.  
  1996. C Informations liees au MATERIAU/COMPORTEMENT
  1997. CMATE = ' '
  1998. IMATE = 0
  1999. INATU = 0
  2000. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU)
  2001. c-dbg write(6,*)'NOMATE : ',cmate,imate,inatu
  2002. c-dbg write(6,*)' MATMOD =',(matmod(i),i=1,nmat)
  2003. IF (IERR.NE.0) then
  2004. write(ioimp,*) ' Probleme apres NOMATE'
  2005. CALL ERREUR(251)
  2006. GOTO 990
  2007. ENDIF
  2008. C* Petit cas particulier en cas de modele VISCO_EXTERNE :
  2009. C* On recupere IVIEX stocke dans INATU (cf. NOMATE)
  2010. IF (INATU .LE. -2) THEN
  2011. IF (.NOT. LMEVIX) THEN
  2012. write(ioimp,*)' VISCO_EXTERNE : INATU & LMEVIX incompatibles'
  2013. call erreur(5)
  2014. return
  2015. ENDIF
  2016. IVIEX = -2 - INATU
  2017. INATU = -2
  2018. ENDIF
  2019. imodel.CMATEE = CMATE
  2020. imodel.IMATEE = IMATE
  2021. imodel.INATUU = INATU
  2022.  
  2023. c imodel.ideriv = jderiv
  2024. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  2025. imodel.IDERIV = 0
  2026.  
  2027. ipmmel = 0
  2028. IF (LESFOR(1).EQ.'MELANGE ') THEN
  2029. IF (CMATE.EQ.'PARALLEL' .OR. CMATE.EQ.'SERIE') THEN
  2030. ipmmel = LESMOD(1)
  2031. if (ipmmel.le.0) then
  2032. call erreur(21)
  2033. GOTO 990
  2034. endif
  2035. ENDIF
  2036. ENDIF
  2037.  
  2038. C +--------------------------------------------------------------------+
  2039. C | Remplissage des couples TYMODE/IVAMOD |
  2040. C +--------------------------------------------------------------------+
  2041. IF (LESFOR(1).EQ.'CONTACT ') THEN
  2042. IF (IFROCA.EQ.0) THEN
  2043. * lecture du mot-cle
  2044. call lirmot(MCTCT,4,iret,0)
  2045. ictct=iret
  2046. if(iret.eq.0) ictct=1
  2047. ictr=2
  2048. if(ictct.ne.2) ictr=1
  2049. * cas mortar : uniquement disponible en 2D
  2050. if (iret.eq.4) then
  2051. if (idim.ne.2) then
  2052. INTERR(1) = IDIM
  2053. CALL ERREUR(1104)
  2054. GOTO 990
  2055. endif
  2056. ictr=4
  2057. endif
  2058. * lecture du deuxieme maillage
  2059. call lirobj('MAILLAGE',ipgeo2,1,iretou)
  2060. if (ierr.ne.0) return
  2061. ipgeox=ipgeo2
  2062. call mocon1(ipgeox,lecont,ictr)
  2063. if(ierr.ne.0) return
  2064. tymode(1)='MAILLAGE'
  2065. ivamod(1)=ipgeom
  2066. tymode(2)='MAILLAGE'
  2067. ivamod(2)=ipgeo2
  2068. tymode(3)='ENTIER'
  2069. ivamod(3)=ictr
  2070. imamod=ipgeox
  2071. if(ictct.eq.2) then
  2072. ip2=ipgeom
  2073. call mocon1(ip2,lecont,ictr)
  2074. if(ierr.ne.0) return
  2075. ip1=imamod
  2076. call fuse(ip1,ip2,iret,.false.)
  2077. if(ierr.ne.0) return
  2078. imamod=iret
  2079. endif
  2080. if(ictct.eq.3) then
  2081. segini,imode1
  2082. mmode2.kmodel(im)=imode1
  2083. ipgeox=ipgeom
  2084. call mocon1(ipgeox,lecont,ictr)
  2085. if(ierr.ne.0) return
  2086. imode1.tymode(1)='MAILLAGE'
  2087. imode1.ivamod(1)=ipgeo2
  2088. imode1.tymode(2)='MAILLAGE'
  2089. imode1.ivamod(2)=ipgeom
  2090. imode1.tymode(3)='ENTIER'
  2091. imode1.ivamod(3)=1
  2092. imode1.imamod=ipgeox
  2093. endif
  2094. ENDIF
  2095.  
  2096. IF (IFROCA.EQ.1) THEN
  2097. * deuxieme maillage deja lu
  2098. ipgeo2 = ipgeom
  2099. ictr=0
  2100. call mocon1(ipgeo2,lecont,ictr)
  2101. if(ierr.ne.0) return
  2102. imamod=ipgeo2
  2103. ipt3=ipgeo2
  2104. segact ipt3
  2105. ityp1=ipt3.itypel
  2106. TYMODE(1)='MAILLAGE'
  2107. IVAMOD(1)=IPGEOM
  2108. TYMODE(2)='MAILLAGE'
  2109. IVAMOD(2)=IBETON
  2110. ENDIF
  2111. ** IF (ifrtt.eq.1) then
  2112. ** ivamod(1)=ipgeo2
  2113. ** tymode(1)='MAILLAGE'
  2114. ** if (ipgeo2.eq.0) then
  2115. ** call erreur(641)
  2116. ** return
  2117. ** endif
  2118. ** ENDIF
  2119.  
  2120. ELSEIF (lesfor(1).eq.'CONTRAINTE ') then
  2121. if (lactr.eq.1.or.lactr.eq.2) then
  2122. call mocon2(ipgeom,ipt7)
  2123. endif
  2124. if (lactr.eq.3) call mocon3(ipgeom,ipt7)
  2125. tymode(1)='ENTIER'
  2126. ivamod(1)=lactr
  2127. tymode(2)='MAILLAGE'
  2128. ivamod(2)=ipgeom
  2129. imamod=ipt7
  2130. * cas rotation idim-1 pts
  2131. if (lactr.eq.1) then
  2132. call meslir(0)
  2133. call lirobj('POINT',ip1,1,iok)
  2134. if (idim.eq.3) call lirobj('POINT',ip2,1,iok)
  2135. if (ierr.ne.0) return
  2136. tymode(3)='POINT'
  2137. ivamod(3)=ip1
  2138. if (idim.eq.3) then
  2139. tymode(4)='POINT'
  2140. ivamod(4)=ip2
  2141. endif
  2142. * cas deplacement 1 pt
  2143. elseif (lactr.eq.2) then
  2144. call lirobj('POINT',ip1,1,iok)
  2145. if (ierr.ne.0) return
  2146. tymode(3)='POINT'
  2147. ivamod(3)=ip1
  2148. endif
  2149.  
  2150. ELSEIF (lesfor(1).eq.'MECANIQUE ') THEN
  2151. IF (LESPRO(2)(1:8).EQ.'MODAL '.and.IPTBMO.GT.0) THEN
  2152. tymode(1) = 'TABLE'
  2153. ivamod(1) = IPTBMO
  2154. ENDIF
  2155. IF (IPMOD3.GT.0) THEN
  2156. nobmod = ivamod(/1)
  2157. tymode(nobmod) = 'MMODEL '
  2158. ivamod(nobmod) = IPMOD3
  2159. ENDIF
  2160.  
  2161. ELSEIF (lesfor(1).eq.'NAVIER_STOKES ') THEN
  2162. IF (nobmod.gt.0) THEN
  2163. tymode(1) = 'LISTMOTS'
  2164. ivamod(1) = opnlin
  2165. ENDIF
  2166.  
  2167. ELSEIF (lesfor(1).eq.'METALLURGIE ') then
  2168. C lucvar : les noms des phases
  2169. IVAMOD(1) = lucvar
  2170. TYMODE(1) = 'LISTMOTS'
  2171. C reacti : les noms des reactifs
  2172. IVAMOD(2) = ireact
  2173. TYMODE(2) = 'LISTMOTS'
  2174. C produi : les noms des produits
  2175. IVAMOD(3) = iprodu
  2176. TYMODE(3) = 'LISTMOTS'
  2177. C lucmat : les noms des types de reactions
  2178. IVAMOD(4) = lucmat
  2179. TYMODE(4) = 'LISTMOTS'
  2180.  
  2181. ELSEIF (lesfor(1).eq.'CHANGEMENT_PHASE') then
  2182. C ipridu : les noms des variables primales et duales
  2183. IVAMOD(1) = ipridu
  2184. TYMODE(1) ='LISTMOTS'
  2185. CALL IMPP1(IPT1,ipgeo2,ipgeo3,LESPRO(1))
  2186. C ipgeo2 & ipgeo3 : MAILLAGE support des Multiplicateurs de Lagrange ('MULT')
  2187. IF (LESPRO(1)(1:10).EQ.'PARFAIT ') THEN
  2188. IVAMOD(2) = ipgeo2
  2189. TYMODE(2) ='MAILLAGE'
  2190. ELSEIF (LESPRO(1)(1:10).EQ.'SOLUBILITE') THEN
  2191. IVAMOD(2) = ipgeo2
  2192. TYMODE(2) ='MAILLAGE'
  2193. IVAMOD(3) = ipgeo3
  2194. TYMODE(3) ='MAILLAGE'
  2195. ELSE
  2196. CALL ERREUR(5)
  2197. ENDIF
  2198.  
  2199. ELSEIF (LESFOR(1).EQ.'THERMIQUE')THEN
  2200. if(IRAYE.ne.0) then
  2201. if(icavit.ne.0) then
  2202. tymode(1)='ENTIER'
  2203. ivamod(1)=nbga
  2204. tymode(2)='ENTIER'
  2205. ivamod(2)=nbdang
  2206. if(isyme.eq.1) then
  2207. tymode(3)='POINT'
  2208. tymode(4)='POINT'
  2209. if(idim.eq.3)tymode(5)='POINT'
  2210. ivamod(3)=ipp1
  2211. ivamod(4)=ipp2
  2212. if(idim.eq.3)ivamod(5)=ipp3
  2213. endif
  2214. endif
  2215. if(ifacaf.ne.0) then
  2216. tymode(1)='MAILLAGE'
  2217. tymode(2)='MAILLAGE'
  2218. tymode(3)='MAILLAGE'
  2219. tymode(4)='MMODEL'
  2220. ivamod(1)= ipfac1
  2221. ivamod(2)= ipfac2
  2222. ivamod(3)= ipfac3
  2223. ivamod(4)= imoco
  2224. endif
  2225. endif
  2226.  
  2227. ELSEIF (LESFOR(1).EQ.'DIFFUSION') THEN
  2228. JGN = LOCOMP
  2229. JGM = 2
  2230. SEGINI,MLMOT1
  2231. TYMODE(NOBDIF+1)='LISTMOTS'
  2232. IVAMOD(NOBDIF+1)=iplrdi
  2233. NOBDIF = NOBDIF+1
  2234. IF (LDILOI.GT.0) THEN
  2235. C Indicateur 'LDIEXT' pour retrouver ses petits
  2236. CALL POSCHA('LDIEXT ',I_POS)
  2237. TYMODE(NOBDIF+1)='MOT '
  2238. IVAMOD(NOBDIF+1)= I_POS
  2239.  
  2240. C Pointeur vers la loi (donne par PTRLOI)
  2241. TYMODE(NOBDIF+2)='ENTIER '
  2242. IVAMOD(NOBDIF+2)= LDIPTR
  2243.  
  2244. C LMELIB : Nom de la bibliotheque (sans chemin et extension)
  2245. CALL POSCHA(LDILIB(1:LDILGB),I_POS)
  2246. TYMODE(NOBDIF+3)='MOT '
  2247. IVAMOD(NOBDIF+3)= I_POS
  2248.  
  2249. C LMEFCT : Nom de la fonction (dans la bibliotheque)
  2250. CALL POSCHA(LDIFCT(1:LDILGT),I_POS)
  2251. TYMODE(NOBDIF+4)='MOT '
  2252. IVAMOD(NOBDIF+4)= I_POS
  2253. NOBDIF = NOBDIF + 4
  2254. ENDIF
  2255.  
  2256. ELSEIF (LMEEXT) THEN
  2257. C Modeles utilisateur en MECANIQUE :
  2258. IF (LMELOI.GT.0) THEN
  2259. C Indicateur 'LMEEXT' pour retrouver ses petits
  2260. CALL POSCHA('LMEEXT ',I_POS)
  2261. TYMODE(NOBMEC+1)='MOT '
  2262. IVAMOD(NOBMEC+1)= I_POS
  2263.  
  2264. C Pointeur vers la loi (donne par PTRLOI)
  2265. TYMODE(NOBMEC+2)='ENTIER '
  2266. IVAMOD(NOBMEC+2)= LMEPTR
  2267.  
  2268. C LMELIB : Nom de la bibliotheque (sans chemin et extension)
  2269. CALL POSCHA(LMELIB(1:LMELGB),I_POS)
  2270. TYMODE(NOBMEC+3)='MOT '
  2271. IVAMOD(NOBMEC+3)= I_POS
  2272.  
  2273. C LMEFCT : Nom de la fonction (dans la bibliotheque)
  2274. CALL POSCHA(LMEFCT(1:LMELGT),I_POS)
  2275. TYMODE(NOBMEC+4)='MOT '
  2276. IVAMOD(NOBMEC+4)= I_POS
  2277. NOBMEC = NOBMEC + 4
  2278. ENDIF
  2279.  
  2280. IF (LMEVIX) THEN
  2281. c* IF (INATU .EQ. -2) THEN
  2282. NOBMEC = NOBMEC + 1
  2283. imodel.TYMODE(NOBMEC) = 'IVIEX '
  2284. imodel.IVAMOD(NOBMEC) = IVIEX
  2285. C NOBMEC = NOBMEC + 1
  2286. C imodel.TYMODE(NOBMEC) = 'ENTIER '
  2287. C imodel.IVAMOD(NOBMEC) = 0
  2288. ENDIF
  2289.  
  2290. ELSE IF (LESFOR(1).EQ.'LIAISON ') THEN
  2291. if (klcon.gt.0) THEN
  2292. do i = 1, klcon
  2293. if (tlicon(i).eq.6) TYMODE(noblia+i) = 'CONDINFE'
  2294. if (tlicon(i).eq.7) TYMODE(noblia+i) = 'CONDSUPE'
  2295. IVAMOD(noblia+i) = mlicon(i)
  2296. enddo
  2297. ENDIF
  2298.  
  2299. ENDIF
  2300. if (jlmot1.gt.0) then
  2301. ivamod(1) = jlmot1
  2302. ivamod(2) = jlmot2
  2303. tymode(1) = 'LISTMOTS'
  2304. tymode(2) = 'LISTMOTS'
  2305. lucvar = jlmot1
  2306. lucmat = jlmot2
  2307. endif
  2308.  
  2309. C=DEB==== FORMULATION HHO ==== Remplissage de donnees ==================
  2310. IF (loHHO) THEN
  2311. modHHO = imodel
  2312. CALL HHOPRM(chaHHO,modHHO,nobHHO,iplHHO,iret)
  2313. IF (iret.NE.0) THEN
  2314. CALL ERREUR(iret)
  2315. GOTO 990
  2316. END IF
  2317. END IF
  2318. C=FIN==== FORMULATION HHO ==============================================
  2319.  
  2320. c* IF (FORMOD(1).EQ.'MELANGE ') THEN
  2321. IF (ipmmel.GT.0) THEN
  2322. mmode1 = ipmmel
  2323. n1mel = mmode1.kmodel(/1)
  2324. NOBMOI = ivamod(/1)
  2325. NOBMOD = NOBMOI + n1mel
  2326. SEGADJ,IMODEL
  2327. kbmod = 0
  2328. DO i = 1, n1mel
  2329. imode1 = mmode1.kmodel(i)
  2330. if (imode1.imamod.eq.imamod) then
  2331. if (kbmod.eq.0) then
  2332. imode2 = imode1
  2333. else
  2334. if (imode1.formod(1).ne.imode2.formod(1).or.
  2335. & imode1.imatee.ne.imode2.imatee) goto 117
  2336. endif
  2337. kbmod = kbmod + 1
  2338. tymode(NOBMOI+kbmod) = 'IMODEL'
  2339. ivamod(NOBMOI+kbmod) = imode1
  2340. endif
  2341. 117 continue
  2342. ENDDO
  2343. if (kbmod.eq.0) then
  2344. call erreur(21)
  2345. return
  2346. endif
  2347. if (kbmod.ne.n1mel) then
  2348. NOBMOD = NOBMOI + kbmod
  2349. SEGADJ,imodel
  2350. endif
  2351. ENDIF
  2352. c* ENDIF
  2353. c-dbg write(ioimp,*) 'Fin remplissage IVAMOD/TYMODE'
  2354.  
  2355. C +--------------------------------------------------------------------+
  2356. C | Determination de la valeur de NEFMOD pour IMODEL |
  2357. C +--------------------------------------------------------------------+
  2358. C Affectation du type d'ELEMENTS FINIS si donnes par utilisateur
  2359.  
  2360. C Cas des SURE (relation de conformite) :
  2361. C NEPAPA = si EF specifique demande -> on utilise ses inconnues
  2362. NEPAPA = 0
  2363. IF (ITYP1.EQ.48) THEN
  2364. imodel.NEFMOD = 259
  2365. IF (ITEF.GT.0) THEN
  2366. DO i=1,ITEF
  2367. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  2368. IF (MELE.NE.0) NEPAPA = MELE
  2369. ENDDO
  2370. ENDIF
  2371. IF (NEPAPA.EQ.0) THEN
  2372. c 2D -> on choisit les inconnues du QUA4 pour toute formulation
  2373. IF (IDIM.EQ.2) THEN
  2374. NEPAPA=8
  2375. c 3D -> on choisit les inconnues du CUB8 pour toute formulation
  2376. ELSEIF (IDIM.EQ.3) THEN
  2377. NEPAPA=14
  2378. ELSE
  2379. CALL ERREUR(610)
  2380. RETURN
  2381. ENDIF
  2382. ENDIF
  2383. MELE = NEPAPA
  2384. GOTO 101
  2385. ENDIF
  2386.  
  2387. C=DEB==== FORMULATION HHO ==== NEFMOD = HHO_NUM_ELEMENT pour tous les elements =====
  2388. IF (loHHO) THEN
  2389. imodel.NEFMOD = HHO_NUM_ELEMENT
  2390. MELE = imodel.NEFMOD
  2391. GOTO 101
  2392. END IF
  2393. C=FIN==== FORMULATION HHO ==============================================
  2394.  
  2395. NEFMOD = 0
  2396. IF (ITEF.NE.0) THEN
  2397. C Cas de la FORMULATION 'NAVIER_STOKES'
  2398. IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN
  2399. IF (LESTEF(1).EQ.'LINE')THEN
  2400. IF (ITYP1.EQ. 3) NEFMOD=129
  2401. IF (ITYP1.EQ. 7) NEFMOD=130
  2402. IF (ITYP1.EQ.11) NEFMOD=131
  2403. IF (ITYP1.EQ.33) NEFMOD=132
  2404. IF (ITYP1.EQ.34) NEFMOD=133
  2405. IF (ITYP1.EQ.35) NEFMOD=134
  2406. IF (ITYP1.EQ.36) NEFMOD=135
  2407. ELSE IF(LESTEF(1).EQ.'MACR')THEN
  2408. IF (ITYP1.EQ. 3) NEFMOD=136
  2409. IF (ITYP1.EQ. 7) NEFMOD=137
  2410. IF (ITYP1.EQ.11) NEFMOD=138
  2411. IF (ITYP1.EQ.33) NEFMOD=139
  2412. IF (ITYP1.EQ.34) NEFMOD=140
  2413. IF (ITYP1.EQ.35) NEFMOD=141
  2414. IF (ITYP1.EQ.36) NEFMOD=142
  2415. C Il nous manque la pyramide
  2416. ELSE IF (LESTEF(1).EQ.'QUAF') THEN
  2417. IF (ITYP1.EQ. 3) NEFMOD=143
  2418. IF (ITYP1.EQ. 7) NEFMOD=144
  2419. IF (ITYP1.EQ.11) NEFMOD=145
  2420. IF (ITYP1.EQ.33) NEFMOD=146
  2421. IF (ITYP1.EQ.34) NEFMOD=147
  2422. IF (ITYP1.EQ.35) NEFMOD=148
  2423. IF (ITYP1.EQ.36) NEFMOD=149
  2424. C Il nous manque la pyramide
  2425. ELSE IF (LESTEF(1).EQ.'LINB') THEN
  2426. IF (ITYP1.EQ. 3) NEFMOD=158
  2427. IF (ITYP1.EQ. 7) NEFMOD=159
  2428. IF (ITYP1.EQ.11) NEFMOD=160
  2429. IF (ITYP1.EQ.33) NEFMOD=161
  2430. IF (ITYP1.EQ.34) NEFMOD=162
  2431. C IF (ITYP1.EQ.35) NEFMOD=163
  2432. C IF (ITYP1.EQ.36) NEFMOD=164
  2433. C Il nous manque la pyramide et le tetrahedre
  2434. ELSE
  2435. DO i=1,ITEF
  2436. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  2437. IF (MELE.EQ.0) GOTO 99
  2438. MEGE=NUMGEO(MELE)
  2439. IF (MEGE.EQ.0) GOTO 99
  2440. IF (MEGE.EQ.ITYP1) GOTO 610
  2441. ENDDO
  2442. GOTO 99
  2443. 610 NEFMOD=MELE
  2444. ENDIF
  2445. C Cas de la FORMULATION 'EULER'
  2446. ELSE IF (LESFOR(1).EQ.'EULER') THEN
  2447. IF (ITYP1.EQ. 2) NEFMOD=ITYP1
  2448. IF (ITYP1.EQ. 4) NEFMOD=ITYP1
  2449. IF (ITYP1.EQ. 8) NEFMOD=ITYP1
  2450. IF (ITYP1.EQ.14) NEFMOD=ITYP1
  2451. IF (ITYP1.EQ.16) NEFMOD=ITYP1
  2452. IF (ITYP1.EQ.23) NEFMOD=ITYP1
  2453. IF (ITYP1.EQ.25) NEFMOD=ITYP1
  2454. C Cas des autres FORMULATIONs
  2455. ELSE
  2456. DO i=1,ITEF
  2457. if(lestef(i)(1:4).eq.'BBAR') lobbar = .true.
  2458. if (lobbar) CALL MODE20(ITYP1,LESTEF(I))
  2459. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  2460. IF (MELE.EQ.0) GOTO 99
  2461. MEGE=NUMGEO(MELE)
  2462. IF (MEGE.EQ.0) GOTO 99
  2463. IF (MEGE.EQ.ITYP1) GOTO 6
  2464. c kich cas du POI1
  2465. if (ityp1.eq.1) goto 6
  2466. ENDDO
  2467. GOTO 99
  2468. C Cas particulier pour les elements polygonaux
  2469. 6 IF (ITYP1.EQ.32) THEN
  2470. MELE=MELE+NBNN-3
  2471. IF (NBNN.GT.14) GOTO 99
  2472. ENDIF
  2473. NEFMOD=MELE
  2474. ENDIF
  2475. C Affectation des elements finis de maniere automatique
  2476. ELSE
  2477. C Cas des milieux POREUX
  2478. IF (LESFOR(1).EQ.'POREUX') THEN
  2479. IF (ITYP1.EQ. 6) NEFMOD=79
  2480. IF (ITYP1.EQ.10) NEFMOD=80
  2481. IF (ITYP1.EQ.15) NEFMOD=81
  2482. IF (ITYP1.EQ.24) NEFMOD=82
  2483. IF (ITYP1.EQ.17) NEFMOD=83
  2484. IF (ITYP1.EQ.29) NEFMOD=108
  2485. IF (ITYP1.EQ.30) NEFMOD=109
  2486. IF (ITYP1.EQ.31) NEFMOD=110
  2487. C Cas des elements de frottement (formulation FROTTEMENT)
  2488. ELSE IF (LESFOR(1).EQ.'CONTACT') THEN
  2489. NEFMOD=22
  2490. if(ifrtt.eq.1) then
  2491. IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=107
  2492. IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=165
  2493. elseif(ifroca.ne.0) then
  2494. IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=261
  2495. IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=262
  2496. endif
  2497. C Cas des elements de contrainte (formulation CONTRAINTE)
  2498. ELSE IF (LESFOR(1).EQ.'CONTRAINTE') THEN
  2499. NEFMOD=22
  2500. C Cas des elements hybrides (imposes en DARCY)
  2501. ELSE IF (LESFOR(1).EQ.'DARCY') THEN
  2502. IF (ITYP1.EQ. 3) NEFMOD=143
  2503. C IF (ITYP1.EQ. 4) NEFMOD=99
  2504. C IF (ITYP1.EQ. 8) NEFMOD=100
  2505. C IF (ITYP1.EQ.23) NEFMOD=101
  2506. C IF (ITYP1.EQ.16) NEFMOD=102
  2507. C IF (ITYP1.EQ.14) NEFMOD=103
  2508. IF (ITYP1.EQ. 7) NEFMOD=99
  2509. IF (ITYP1.EQ.11) NEFMOD=100
  2510. IF (ITYP1.EQ.35) NEFMOD=101
  2511. IF (ITYP1.EQ.34) NEFMOD=102
  2512. IF (ITYP1.EQ.33) NEFMOD=103
  2513. C Cas de la formulation MAGNETODYNAMIQUE
  2514. ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  2515. IF (ITYP1.EQ. 4) NEFMOD=128
  2516. C Cas de la formulation 'NAVIER_STOKES'
  2517. ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN
  2518. IF (ILNAVI.EQ.0) THEN
  2519. CALL MESLIR(-341)
  2520. GOTO 990
  2521. ELSEIF (ILNAVI.EQ.1) THEN
  2522. C LICE
  2523. IF (ITYP1.EQ. 3) NEFMOD=195
  2524. IF (ITYP1.EQ. 7) NEFMOD=196
  2525. IF (ITYP1.EQ.11) NEFMOD=197
  2526. IF (ITYP1.EQ.33) NEFMOD=198
  2527. IF (ITYP1.EQ.34) NEFMOD=199
  2528. IF (ITYP1.EQ.35) NEFMOD=200
  2529. IF (ITYP1.EQ.36) NEFMOD=201
  2530. ELSEIF (ILNAVI.EQ.2) THEN
  2531. C LIMS
  2532. IF (ITYP1.EQ. 3) NEFMOD=202
  2533. IF (ITYP1.EQ. 7) NEFMOD=203
  2534. IF (ITYP1.EQ.11) NEFMOD=204
  2535. IF (ITYP1.EQ.33) NEFMOD=205
  2536. IF (ITYP1.EQ.34) NEFMOD=206
  2537. IF (ITYP1.EQ.35) NEFMOD=207
  2538. IF (ITYP1.EQ.36) NEFMOD=208
  2539. ELSEIF (ILNAVI.EQ.3) THEN
  2540. C LBMS
  2541. IF (ITYP1.EQ. 3) NEFMOD=209
  2542. IF (ITYP1.EQ. 7) NEFMOD=210
  2543. IF (ITYP1.EQ.11) NEFMOD=211
  2544. IF (ITYP1.EQ.33) NEFMOD=212
  2545. IF (ITYP1.EQ.34) NEFMOD=213
  2546. IF (ITYP1.EQ.35) NEFMOD=214
  2547. IF (ITYP1.EQ.36) NEFMOD=215
  2548. ELSEIF (ILNAVI.EQ.4) THEN
  2549. C MCCE
  2550. IF (ITYP1.EQ. 3) NEFMOD=216
  2551. IF (ITYP1.EQ. 7) NEFMOD=217
  2552. IF (ITYP1.EQ.11) NEFMOD=218
  2553. IF (ITYP1.EQ.33) NEFMOD=219
  2554. IF (ITYP1.EQ.34) NEFMOD=220
  2555. IF (ITYP1.EQ.35) NEFMOD=221
  2556. IF (ITYP1.EQ.36) NEFMOD=222
  2557. ELSEIF (ILNAVI.EQ.5) THEN
  2558. C MCP1
  2559. IF (ITYP1.EQ. 3) NEFMOD=223
  2560. IF (ITYP1.EQ. 7) NEFMOD=224
  2561. IF (ITYP1.EQ.11) NEFMOD=225
  2562. IF (ITYP1.EQ.33) NEFMOD=226
  2563. IF (ITYP1.EQ.34) NEFMOD=227
  2564. IF (ITYP1.EQ.35) NEFMOD=228
  2565. IF (ITYP1.EQ.36) NEFMOD=229
  2566. ELSEIF (ILNAVI.EQ.6) THEN
  2567. C MCMS
  2568. IF (ITYP1.EQ. 3) NEFMOD=230
  2569. IF (ITYP1.EQ. 7) NEFMOD=231
  2570. IF (ITYP1.EQ.11) NEFMOD=232
  2571. IF (ITYP1.EQ.33) NEFMOD=233
  2572. IF (ITYP1.EQ.34) NEFMOD=234
  2573. IF (ITYP1.EQ.35) NEFMOD=235
  2574. IF (ITYP1.EQ.36) NEFMOD=236
  2575. ELSEIF (ILNAVI.EQ.7) THEN
  2576. C QFCE
  2577. IF (ITYP1.EQ. 3) NEFMOD=237
  2578. IF (ITYP1.EQ. 7) NEFMOD=238
  2579. IF (ITYP1.EQ.11) NEFMOD=239
  2580. IF (ITYP1.EQ.33) NEFMOD=240
  2581. IF (ITYP1.EQ.34) NEFMOD=241
  2582. IF (ITYP1.EQ.35) NEFMOD=242
  2583. IF (ITYP1.EQ.36) NEFMOD=243
  2584. ELSEIF (ILNAVI.EQ.8) THEN
  2585. C QFP1
  2586. IF (ITYP1.EQ. 3) NEFMOD=244
  2587. IF (ITYP1.EQ. 7) NEFMOD=245
  2588. IF (ITYP1.EQ.11) NEFMOD=246
  2589. IF (ITYP1.EQ.33) NEFMOD=247
  2590. IF (ITYP1.EQ.34) NEFMOD=248
  2591. IF (ITYP1.EQ.35) NEFMOD=249
  2592. IF (ITYP1.EQ.36) NEFMOD=250
  2593. ELSEIF (ILNAVI.EQ.9) THEN
  2594. C QFMS
  2595. IF (ITYP1.EQ. 3) NEFMOD=251
  2596. IF (ITYP1.EQ. 7) NEFMOD=252
  2597. IF (ITYP1.EQ.11) NEFMOD=253
  2598. IF (ITYP1.EQ.33) NEFMOD=254
  2599. IF (ITYP1.EQ.34) NEFMOD=255
  2600. IF (ITYP1.EQ.35) NEFMOD=256
  2601. IF (ITYP1.EQ.36) NEFMOD=257
  2602. ENDIF
  2603. C Cas de la formulation 'EULER'
  2604. ELSE IF (LESFOR(1).EQ.'EULER') THEN
  2605. IF (ITYP1.EQ. 2) NEFMOD=ITYP1
  2606. IF (ITYP1.EQ. 4) NEFMOD=ITYP1
  2607. IF (ITYP1.EQ. 8) NEFMOD=ITYP1
  2608. IF (ITYP1.EQ.14) NEFMOD=ITYP1
  2609. IF (ITYP1.EQ.16) NEFMOD=ITYP1
  2610. IF (ITYP1.EQ.23) NEFMOD=ITYP1
  2611. IF (ITYP1.EQ.25) NEFMOD=ITYP1
  2612. C Cas des autres formulations
  2613. ELSE
  2614. NEFMOD=ITYP1
  2615. c kich cas du POI1
  2616. if (ityp1.eq.1) nefmod = 45
  2617. C Cas particuliers des elements polygonaux
  2618. IF (NEFMOD.EQ.32) NEFMOD=111+NBNN-3
  2619. c gounand cas des 'CU27','PR21','TE15','PY19'
  2620. if (NEFMOD.GE.33.AND.NEFMOD.LE.36) then
  2621. nefmod = nefmod-33 +275
  2622. endif
  2623. C Cas particuliers des elements finis pour IDIM=1
  2624. IF (IDIM.EQ.1) THEN
  2625. NEFMOD = 0
  2626. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  2627. IF (ICONV.NE.0 .OR. IRAYE.NE.0) THEN
  2628. IF (ITYP1.EQ.1) NEFMOD=45
  2629. IF (ITYP1.EQ.2) NEFMOD=ITYP1
  2630. ELSE
  2631. IF (ITYP1.EQ.2) NEFMOD=191
  2632. IF (ITYP1.EQ.3) NEFMOD=192
  2633. ENDIF
  2634. ELSE IF (LESFOR(1).EQ.'MECANIQUE') THEN
  2635. IF (ITYP1.EQ.2) NEFMOD=193
  2636. IF (ITYP1.EQ.3) NEFMOD=194
  2637. ELSE IF (LESFOR(1).EQ.'FISSURE') THEN
  2638. IF (ITYP1.EQ.2) NEFMOD=ITYP1
  2639. ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN
  2640. IF (ITYP1.EQ.2) NEFMOD=193
  2641. IF (ITYP1.EQ.3) NEFMOD=194
  2642. ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN
  2643. * En attendant le retour a la normale pour la diffusion, on ajoute une
  2644. * enieme rustine en mettant les memes elements qu'en thermique.
  2645. ** IF (ITYP1.EQ.2) NEFMOD=193
  2646. ** IF (ITYP1.EQ.3) NEFMOD=194
  2647. IF (ITYP1.EQ.2) NEFMOD=191
  2648. IF (ITYP1.EQ.3) NEFMOD=192
  2649. ENDIF
  2650. ENDIF
  2651. ENDIF
  2652. ENDIF
  2653. IF (NEFMOD.EQ.0) GOTO 99
  2654. MELE = NEFMOD
  2655. 101 CONTINUE
  2656. C +--------------------------------------------------------------------+
  2657. C | Fin de la valeur de NEFMOD pour IMODEL |
  2658. C +--------------------------------------------------------------------+
  2659. MFR = NUMMFR(NEFMOD)
  2660. mfr2 = NUMMFR(MELE)
  2661. c-dbg write(6,*)' ITYP1 =',ityp1,nefmod,mele,MFR,mfr2
  2662.  
  2663. C +--------------------------------------------------------------------+
  2664. C Quelques tests supplementaires en attendant mieux
  2665. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  2666. C nnz = MATMOD(/2)
  2667. iplaz = 0
  2668. call place(MATMOD,MATMOD(/2),iplaz,'PHASE')
  2669. IF (iplaz.ne.0 ) THEN
  2670. c test que les elements sont lineaires
  2671. c* on a aussi : ipt4 = ipt1 = imodel.imamod
  2672. ipt4 = imodel.imamod
  2673. itt = ipt4.itypel
  2674. if (kdegre(itt) .gt. 2) then
  2675. call erreur(982)
  2676. goto 990
  2677. endif
  2678. ENDIF
  2679. ENDIF
  2680.  
  2681. IF (LESFOR(1).EQ.'MECANIQUE') THEN
  2682. C Cas du materiau unidirectionnel
  2683. IF (IMATE.EQ.4) THEN
  2684. C Cas des cerces : sans interet !
  2685. IF (MFR.EQ.27) THEN
  2686. CALL ERREUR(251)
  2687. GOTO 990
  2688. ENDIF
  2689. C Cas de la plasticite
  2690. IF (INATU.NE.0) THEN
  2691. C OK si massif bidim ou si coque tridim dans le cas acier_uni
  2692. IF (INATU.EQ.40)THEN
  2693. IF ((MFR.NE.1.OR.IFOUR.GT.0).AND.
  2694. & ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN
  2695. CALL ERREUR(251)
  2696. GOTO 990
  2697. ENDIF
  2698. C Dans les autres cas, on n'autorise pour le moment que COQ2 et massif
  2699. ELSE IF (MELE.NE.44.AND.MFR.NE.1) THEN
  2700. CALL ERREUR(251)
  2701. GOTO 990
  2702. ENDIF
  2703. ENDIF
  2704. ENDIF
  2705. C
  2706. C Cas du materiau 'ZONE_COHESIVE'
  2707. IF (IMATE.EQ.12) THEN
  2708. IF (MFR.NE.77) THEN
  2709. CALL ERREUR(251)
  2710. GOTO 990
  2711. ENDIF
  2712. ENDIF
  2713.  
  2714. C Cas du modele section : on n'autorise pour le moment que TIMO
  2715. IF (CMATE.EQ.'SECTION'.AND.MELE.NE.84) THEN
  2716. CALL ERREUR(251)
  2717. GOTO 990
  2718. ENDIF
  2719. ENDIF
  2720. C Le modele de GURSON n'est possible qu'en 3D, axisymetrique ou
  2721. C deformations planes
  2722. IF (INATU.EQ.38) THEN
  2723. IF ( IFOUR.NE.0 .AND. IFOUR.NE.2 .AND. IFOUR.NE.-1 ) THEN
  2724. MOTERR(1:8)='GURSON'
  2725. MOTERR(9:16)='MECANIQU'
  2726. INTERR(1) = IFOUR
  2727. CALL ERREUR (81)
  2728. GOTO 990
  2729. ENDIF
  2730. ENDIF
  2731.  
  2732. C Le modele ISS_GRANGE n'est utilisable qu'en 3D
  2733. IF (INATU.EQ.151 .AND. IFOUR.NE.2) THEN
  2734. INTERR(1) = IFOUR
  2735. CALL ERREUR (709)
  2736. GOTO 990
  2737. ENDIF
  2738. C Le modele RUP_THER n'est utilisable qu'en 3D
  2739. IF (INATU.EQ.152 .AND. IFOUR.NE.2) THEN
  2740. INTERR(1) = IFOUR
  2741. CALL ERREUR (709)
  2742. GOTO 990
  2743. ENDIF
  2744. C Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1
  2745. IF (INATU.EQ.34 .AND. IFOUR.NE.2 .AND. MFR.EQ.75) THEN
  2746. INTERR(1) = IFOUR
  2747. CALL ERREUR (709)
  2748. GOTO 990
  2749. ENDIF
  2750. C.. Restrictions en formulation 'MECANIQUE' avec une loi de
  2751. C comportement non lineaire externe
  2752. C Rappel : LMEEXT exprime la condition (NFOR.EQ.1) ET
  2753. C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
  2754. IF ( LMEEXT ) THEN
  2755. C En formulation 'MECANIQUE', les lois non lineaires externes
  2756. C n'autorisent qu'une seule composante de temperature
  2757. C => incompatibilite avec des modeles de coques n'ayant pas
  2758. C de points d'integration dans l'epaisseur (trois composantes
  2759. C dans ce cas, 'TINF', 'T ' et 'TSUP')
  2760. C Le test ci-dessous est coherent avec celui de IDTEMP.
  2761. IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND.
  2762. & (NGINT.EQ.0) ) THEN
  2763. CALL ERREUR(951)
  2764. GOTO 990
  2765. ENDIF
  2766. C Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour
  2767. C l'instant qu'aux elements massifs, avec option de calcul 3D
  2768. C Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL'
  2769. IF ( LMEVIX ) THEN
  2770. IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN
  2771. KERRE = 950
  2772. ELSE IF ( IVIEX.NE.1 ) THEN
  2773. KERRE = 958
  2774. ELSE
  2775. KERRE = 0
  2776. ENDIF
  2777. IF (KERRE.NE.0) THEN
  2778. CALL ERREUR(KERRE)
  2779. GOTO 990
  2780. ENDIF
  2781. ENDIF
  2782. ENDIF
  2783.  
  2784. C Formulation 'THERMIQUE' 'CONVECTION'
  2785. C Adequation EF de type COQue et mot 'INFERIEURE' / 'SUPERIEURE'
  2786. IF (ICONV.EQ.1) THEN
  2787. CALL PLACE(LESPRO,NMAT,ISUP,'SUPERIEURE')
  2788. CALL PLACE(LESPRO,NMAT,IINF,'INFERIEURE')
  2789. ITOT = ISUP+IINF
  2790. LOGRE = MELE.EQ.27 .OR. MELE.EQ.41 .OR. MELE.EQ.44 .OR.
  2791. & MELE.EQ.49 .OR. MELE.EQ.56
  2792. IF ( ITOT.NE.0.AND.(.NOT. LOGRE) ) THEN
  2793. CALL ERREUR(16)
  2794. GOTO 990
  2795. ENDIF
  2796. IF ( ITOT.EQ.0 .AND. LOGRE) THEN
  2797. CALL ERREUR(513)
  2798. GOTO 990
  2799. ENDIF
  2800. ENDIF
  2801.  
  2802. C Formulation 'DIFFUSION' :
  2803. IF (LESFOR(1) .EQ. 'DIFFUSION') THEN
  2804. C - Verification sur les types de FORMULATION et/ou d'elements
  2805. IF (IFOUR.EQ.2 .AND. MELE.GE.4 .AND. MELE.LT.11) THEN
  2806. CALL ERREUR(16)
  2807. GOTO 99
  2808. ENDIF
  2809. IF (MFR.NE.1 .AND. MFR.NE.3 .AND. MFR.NE.5 .AND.
  2810. & MFR.NE.7 .AND. MFR.NE.9 .AND. MFR.NE.73 .AND.
  2811. & MFR.NE.27 .AND. MFR.NE.75 .AND. MFR.NE.79 ) THEN
  2812. CALL ERREUR(16)
  2813. GOTO 99
  2814. ENDIF
  2815. ENDIF
  2816.  
  2817. C Formulation 'ELECTROSTATIQUE' :
  2818. C Petite verification (a priori sans probleme)
  2819. IF (LESFOR(1) .EQ. 'ELECTROSTATIQUE ') THEN
  2820. IF (MFR .NE. 1) THEN
  2821. CALL ERREUR(21)
  2822. GOTO 99
  2823. ENDIF
  2824. ENDIF
  2825.  
  2826. C +--------------------------------------------------------------------+
  2827. C | Remplissage INFMOD et INFELE du IM-eme modele elementaire IMODEL |
  2828. C +--------------------------------------------------------------------+
  2829. IF (NGINT.NE.0.AND.MELE.NE.28) THEN
  2830. CALL ERREUR(608)
  2831. GOTO 990
  2832. ENDIF
  2833. INFMOD(1) = NGINT
  2834.  
  2835. C (fdp) Pour les elements JOI1 seulement, on stocke -1*ILIE dans INFMOD(9)
  2836. IF (ILIE.NE.0) THEN
  2837. IF (MELE.NE.265) THEN
  2838. CALL ERREUR(19)
  2839. GOTO 990
  2840. ENDIF
  2841. INFMOD(9) = -1 * ILIE
  2842. ENDIF
  2843. * AM cas non-local
  2844. IF (INLOC.NE.0) THEN
  2845. INFMOD(13) = -1*INLOC
  2846. INFMOD(14) = LULVIA
  2847. ENDIF
  2848.  
  2849. C Initialisation du infele et des segments d'integration
  2850. infele(2) = NGINT
  2851. infele(3) = NGMAS
  2852. infele(4) = NGCON
  2853. infele(6) = NGRIG
  2854.  
  2855. C Cas particulier des relations de conformite pour les SURE
  2856. IF (ITYP1.EQ.48) THEN
  2857. imodel.infele( 1) = nefmod
  2858. imodel.infele(14) = 48
  2859. imodel.infele(13) = mfr2
  2860. C* Serait-il interessant de stocker mele=nepapa dans infele ?
  2861. c-dbg write(ioimp,*) 'ITYP1 = SURE',ityp1,nefmod,mele,mfr,mfr2
  2862. ENDIF
  2863.  
  2864. CALL prquoi(imodel)
  2865. if (ierr.ne.0) return
  2866.  
  2867. C +--------------------------------------------------------------------+
  2868. C | Initialisation des nomid (NOMS des composantes) |
  2869. C +--------------------------------------------------------------------+
  2870.  
  2871. C cas particulier des relations de conformite pour les SURE
  2872. c on recupere les noms de composantes 'DEPLACEM' et 'FORCES'
  2873. c des elements parents (NEPAPA => QUA4 ou CUB8)
  2874. if (ITYP1.EQ.48) then
  2875. SEGINI,imode5=IMODEL
  2876. imode5.NEFMOD=NEPAPA
  2877. call inomid(imode5,lucvar,lucmat,lucmaf,luparx)
  2878. if (ierr.ne.0) return
  2879. imodel.LNOMID(1) = imode5.LNOMID(1)
  2880. imodel.LNOMID(2) = imode5.LNOMID(2)
  2881. SEGSUP,imode5
  2882. else
  2883. call inomid(imodel,lucvar,lucmat,lucmaf,luparx)
  2884. if (ierr.ne.0) return
  2885. endif
  2886.  
  2887. C Test CLEMENT entre INFELE(16) et la dimension du NOMID des DEFORMATIONS
  2888. C ATTENTION (celui des CONTRAINTES peut contenir une info en plus sur les MODES en fourier...)
  2889. nomid = imodel.LNOMID(5)
  2890. IF (nomid.GT.0) THEN
  2891. imodel.INFELE(16) = nomid.LESOBL(/2) + nomid.LESFAC(/2)
  2892. ELSE
  2893. imodel.INFELE(16) = 0
  2894. ENDIF
  2895.  
  2896. C +--------------------------------------------------------------------+
  2897. C | Quelques verifications supplementaires |
  2898. C +--------------------------------------------------------------------+
  2899.  
  2900. C=DEB==== FORMULATION HHO ==== Verification des noms primales/duales====
  2901. IF (loHHO) THEN
  2902. nomid1 = imodel.LNOMID(1)
  2903. nomid2 = imodel.LNOMID(2)
  2904. c* SEGACT,nomid1,nomid2
  2905. n_z1 = nomid1.LESOBL(/2)
  2906. n_z2 = nomid2.LESOBL(/2)
  2907. IF (n_z1.EQ.0 .OR. n_z1.NE.n_z2) THEN
  2908. write(ioimp,*) 'MODELI HHO: PRIMAL/DUAL number incorrect'
  2909. CALL ERREUR(5)
  2910. RETURN
  2911. END IF
  2912. DO i = 1, n_z1
  2913. CALL VERMDI(nomid1.LESOBL(i),nomid2.LESOBL(i))
  2914. IF (IERR.NE.0) RETURN
  2915. END DO
  2916. n_z1 = nomid1.LESFAC(/2)
  2917. n_z2 = nomid2.LESFAC(/2)
  2918. IF (n_z1.NE.0 .OR. n_z2.NE.0) THEN
  2919. write(ioimp,*) 'MODELI HHO: LESFAC incorrect'
  2920. CALL ERREUR(5)
  2921. RETURN
  2922. END IF
  2923. END IF
  2924. C=FIN==== FORMULATION HHO ==============================================
  2925.  
  2926. C - Modele UTILISATEUR :
  2927. C Verification que les composantes materiaux "obligatoires" sont declarees
  2928. IF (LDIEXT) THEN
  2929. NOMID = IMODEL.LNOMID(6)
  2930. NBROBL = NOMID.LESOBL(/2)
  2931. MLMOT1 = lucmat
  2932. SEGACT,MLMOT1
  2933. NBCOMP = MLMOT1.MOTS(/2)
  2934. ICOMP = 0
  2935. DO i = 1, NBROBL
  2936. CALL PLACE(MLMOT1.MOTS,NBCOMP,IPLAC,NOMID.LESOBL(i))
  2937. IF (IPLAC.EQ.0) THEN
  2938. WRITE(IOIMP,80) MOTS(i)
  2939. 80 FORMAT('La composante obligatoire "',A8,'" est absente')
  2940. ELSE
  2941. ICOMP = ICOMP+1
  2942. ENDIF
  2943. ENDDO
  2944. IF (ICOMP.NE.NBROBL) GOTO 99
  2945. ENDIF
  2946.  
  2947. mfr2 = INFELE(13)
  2948. IF (FORMOD(1).EQ.'CONTRAINTE') mfr2 = 0
  2949. ipmo = imodel
  2950. CALL cotemo(ipmo,mfr2)
  2951. IF (IERR.NE.0) RETURN
  2952.  
  2953. C +--------------------------------------------------------------------+
  2954. C | Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14)
  2955. C | Ce point n'est pris en compte que si cela est necessaire
  2956. C +--------------------------------------------------------------------+
  2957. mfr3 = mfr2
  2958. CALL INFDPG(mfr3,IFOUR, LOGRE,ndpge)
  2959. IF (LOGRE) THEN
  2960. C Erreur si ce point support n'est pas fourni avec le mot-cle GENE.
  2961. IF (IPTGEN.EQ.0) THEN
  2962. CALL ERREUR(925)
  2963. RETURN
  2964. ENDIF
  2965. imodel.IPDPGE = IPTGEN
  2966. ELSE
  2967. IF (IPTGEN.NE.0) THEN
  2968. write(ioimp,*) 'Mot-cle GENE + Point ignores...'
  2969. ENDIF
  2970. imodel.IPDPGE = 0
  2971. ENDIF
  2972.  
  2973.  
  2974. SEGACT,IMODEL*NOMOD
  2975.  
  2976. 10 CONTINUE
  2977. C ****************************************************************
  2978. C Fin de la boucle (10) sur les maillages elementaires de IPGEOM
  2979. C ****************************************************************
  2980.  
  2981. * En cas de contact symetrique, on met tout dans le meme modele
  2982. n1o = kmodel(/1)
  2983. n1 = n1o
  2984. do i = 1, n1o
  2985. imode1 = mmode2.kmodel(i)
  2986. if (imode1.ne.0) then
  2987. n1 = n1+1
  2988. endif
  2989. enddo
  2990. * On a trouve du contact :
  2991. if (n1.gt.n1o) then
  2992. segadj mmodel
  2993. nsou1 = n1
  2994. do i = 1, n1o
  2995. imode1 = mmode2.kmodel(i)
  2996. if (imode1.ne.0) then
  2997. kmodel(n1)=imode1
  2998. n1=n1-1
  2999. imodel=kmodel(i)
  3000. imode1.nefmod=nefmod
  3001. imode1.conmod=conmod
  3002. do ip=1,infmod(/1)
  3003. imode1.infmod(ip)=infmod(ip)
  3004. enddo
  3005. do ip=1,formod(/2)
  3006. imode1.formod(ip)=formod(ip)
  3007. enddo
  3008. do ip=1,matmod(/2)
  3009. imode1.matmod(ip)=matmod(ip)
  3010. enddo
  3011. imode1.ipdpge=ipdpge
  3012. imode1.cmatee=cmatee
  3013. imode1.imatee=imatee
  3014. imode1.inatuu=inatuu
  3015. imode1.ideriv=ideriv
  3016. do ip=1,lnomid(/1)
  3017. imode1.lnomid(ip)=lnomid(ip)
  3018. enddo
  3019. do ip=1,infele(/1)
  3020. imode1.infele(ip)=infele(ip)
  3021. enddo
  3022. do ip=1,tymode(/2)
  3023. imode1.tymode(ip)=tymode(ip)
  3024. enddo
  3025. endif
  3026. enddo
  3027. n1 = nsou1
  3028. endif
  3029. segsup mmode2
  3030.  
  3031. IPMODE=MMODEL
  3032.  
  3033. C TABLE DE MODES --------------------------------
  3034. IF (IPTBDM.GT.0) THEN
  3035. MMODEL = IPMODE
  3036. imodel = kmodel(1)
  3037. segact imodel*mod
  3038. call dimen7(iptbdm,idimen)
  3039. NBNN = 1
  3040. NBELEM = idimen - 2
  3041. NBSOUS = 0
  3042. NBREF = 0
  3043. SEGINI IPT8
  3044. IPT8.ITYPEL = 1
  3045.  
  3046. IKM = 0
  3047. DO ik = 1,NBELEM
  3048. IKM = IKM + 1
  3049. IVALIN=IKM
  3050. XVALIN=REAL(0.D0)
  3051. LOGIN=.TRUE.
  3052. IOBIN=0
  3053. TAPIND='ENTIER '
  3054. CHARIN=' '
  3055. TYPOBJ='TABLE'
  3056. CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  3057. . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  3058. IF (IERR.NE.0) RETURN
  3059. IPTMOD = IOBRE
  3060. IVALIN=0
  3061. XVALIN=REAL(0.D0)
  3062. LOGIN=.TRUE.
  3063. IOBIN=0
  3064. TAPIND='MOT '
  3065. TYPOBJ='POINT'
  3066. CALL ACCTAB(IPTMOD,TAPIND,IVALIN,XVALIN,'POINT_REPERE',LOGIN,
  3067. . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  3068. IF (IERR.NE.0) RETURN
  3069.  
  3070. ipt8.num(1,ikm) = iobre
  3071. ENDDO
  3072.  
  3073. NBELEM = IKM
  3074. segadj IPT8
  3075. imamod = ipt8
  3076.  
  3077. ENDIF
  3078. C fin TABLE DE MODES --------------------------------
  3079. C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd
  3080. 91 IF (IPTABS.GT.0.OR.IPMOD1.GT.0) THEN
  3081. c verification formulation
  3082. IF (ipmod1.gt.0) THEN
  3083. CALL ACTOBJ('MMODEL',IPMOD1,1)
  3084. if (ierr.ne.0) return
  3085. mmode1 = ipmod1
  3086. imode1 = mmode1.kmodel(1)
  3087. do jj=1,NFOR
  3088. if (imode1.formod(jj).ne.LESFOR(JJ)) then
  3089. call erreur(21)
  3090. return
  3091. endif
  3092. enddo
  3093. ENDIF
  3094. c duplique le modele cree
  3095. if (ipmod1.le.0) ipmod1 = ipmode
  3096. C modele : pointer le modele elementaire approprie
  3097. IF (iptabm.eq.0) THEN
  3098. MMODE1 = ipmod1
  3099. DO im = 1,kmodel(/1)
  3100. imodel = kmodel(im)
  3101. segact imodel*mod
  3102. nobmod = ivamod(/1)
  3103. nobmod = nobmod + 1
  3104. nfor = formod(/2)
  3105. nmat = matmod(/2)
  3106. mn3 = infmod(/1)
  3107. segadj imodel
  3108. kbmod = 0
  3109. do im1 = 1,MMODE1.KMODEL(/1)
  3110. imode1 = mmode1.kmodel(im1)
  3111. imomo = imode1
  3112. lostat = .true.
  3113.  
  3114. C criteres de verif assez sommaires ...
  3115. if (imode1.nefmod.eq.nefmod.and.
  3116. & imode1.imamod.ne.imamod.and.
  3117. & (imode1.matmod(/2).eq.matmod(/2).or.
  3118. & imode1.matmod(/2).eq.(matmod(/2)-1)).and.
  3119. & imode1.formod(/2).eq.formod(/2)) then
  3120. do lmo = 1,formod(/2)
  3121. if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false.
  3122. enddo
  3123. do lmo = 1,imode1.matmod(/2)
  3124. if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false.
  3125. enddo
  3126. else
  3127. lostat = .false.
  3128. endif
  3129. if (lostat.and.formod(1).eq.'MELANGE') then
  3130. C verifs supplementaires : les modeles de ivamod sont ils bien construi
  3131. lomela = .true.
  3132. if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false.
  3133. if (imode1.ivamod(/1).gt.0) then
  3134. do ivm3 = 1,imode1.ivamod(/1)
  3135. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  3136. imode3 = imode1.ivamod(ivm3)
  3137. segact imode3
  3138. ENDIF
  3139. enddo
  3140. endif
  3141. IF (nobmod.gt.1) THEN
  3142. do ivm1 = 1,(nobmod-1)
  3143. if (tymode(ivm1).eq.'IMODEL ') then
  3144. imode2 = ivamod(ivm1)
  3145. segact imode2
  3146. cc
  3147. if (imode2.ivamod(/1).ge.1) then
  3148. do ivm2 = 1,imode2.ivamod(/1)
  3149. if (imode2.tymode(ivm2).eq.'IMODEL') then
  3150. imode4 = imode2.ivamod(ivm2)
  3151. segact imode4
  3152. if (imode1.ivamod(/1).ge.1) then
  3153. do ivm3 = 1,imode1.ivamod(/1)
  3154. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  3155. imode3 = imode1.ivamod(ivm3)
  3156. cc
  3157. lostat = .true.
  3158. C criteres de verif assez faibles ...
  3159. if (imode3.nefmod.eq.imode4.nefmod.and.
  3160. & imode3.imamod.eq.imode4.imamod.and.
  3161. & imode3.matmod(/2).eq.imode4.matmod(/2).and.
  3162. & imode3.conmod(17:24).eq.imode4.conmod(17:24).and.
  3163. & imode3.formod(/2).eq.imode4.formod(/2)) then
  3164. do lmo = 1,imode4.formod(/2)
  3165. if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false.
  3166. enddo
  3167. do lmo = 1,imode4.matmod(/2)
  3168. if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false.
  3169. enddo
  3170. else
  3171. lostat = .false.
  3172. endif
  3173. if (lostat) then
  3174. goto 75
  3175. endif
  3176. cc
  3177. ENDIF
  3178. enddo
  3179. else
  3180. lostat = .false.
  3181. endif
  3182. endif
  3183. enddo
  3184. C
  3185. else
  3186. lomela = .false.
  3187. endif
  3188.  
  3189. 75 lomela = lomela.and.lostat
  3190. endif
  3191.  
  3192. enddo
  3193. ENDIF
  3194. lostat = lomela
  3195. do ivm3 = 1,imode1.ivamod(/1)
  3196. c imode1 = imomo
  3197. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  3198. imode3 = imode1.ivamod(ivm3)
  3199. ENDIF
  3200. enddo
  3201. endif
  3202. if (lostat) then
  3203. kbmod = kbmod + 1
  3204. tymode(nobmod) = 'IMODEL'
  3205. ivamod(nobmod) = imomo
  3206. goto 79
  3207. endif
  3208. enddo
  3209. C *** ca se passe mal
  3210. if (kbmod.ne.1) then
  3211. write(ioimp,*) ' STATIO EN DEFAUT voir notice ',kbmod,im
  3212. call erreur(251)
  3213. goto 990
  3214. endif
  3215. C ***
  3216. 79 CONTINUE
  3217. ENDDO
  3218. ENDIF
  3219.  
  3220. C : table : dupliquer modele elementaire et pointer
  3221. if (iptabm.gt.0) then
  3222. call modsta(ipmode,iptabm,ipmod1)
  3223. endif
  3224.  
  3225. ENDIF
  3226. C fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd
  3227.  
  3228. if (plicon.ne.0) segsup,plicon
  3229.  
  3230. C Ecriture de l'objet MODELE cree
  3231. CALL ACTOBJ('MMODEL ',IPMODE,1)
  3232. CALL ECROBJ('MMODEL ',IPMODE)
  3233. RETURN
  3234.  
  3235. C Traitement des ERREURS
  3236. 99 CONTINUE
  3237. CALL ERREUR(21)
  3238. 990 CONTINUE
  3239. DO im = 1, kmodel(/1)
  3240. imodel = kmodel(im)
  3241. IF (imodel.NE.0) SEGSUP,imodel
  3242. ENDDO
  3243. SEGSUP,MMODEL
  3244.  
  3245. if (plicon.ne.0) segsup,plicon
  3246.  
  3247. c RETURN
  3248. END
  3249.  
  3250.  
  3251.  
  3252.  

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