Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

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

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