Télécharger modeli.eso

Retour à la liste

Numérotation des lignes :

modeli
  1. C MODELI SOURCE MB234859 25/08/27 21:15:02 12343
  2. C----------------------------------------------------------------------C
  3. C OPERATEUR MODELE C
  4. C C
  5. C Creation d'un objet MODELE C
  6. C C
  7. C Syntaxe : MOD1 = MODL GEO1 TYPE_CAL TYPE_MAT ( TYPE_ELE ) ; C
  8. C C
  9. C GEO1 MAILLAGE de base C
  10. C TYPE_CAL MOT(S) pour definir la FORMULATION C
  11. C TYPE_MAT MOT(S) pour definir le MATERIAU C
  12. C TYPE_ELE MOT(S) pour definir les ELEMENTS FINIS a utiliser C
  13. C MOD1 Resultat de type MODELE C
  14. C----------------------------------------------------------------------C
  15. C PPU : Modif pour les materiaux unidirectionels en plasticite
  16.  
  17. SUBROUTINE MODELI
  18.  
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC CCHAMP
  25. -INC CCGEOME
  26. C==DEB= FORMULATION HHO == Include specifique ==========================
  27. -INC CCHHOPA
  28. C==FIN= FORMULATION HHO ================================================
  29. -INC SMCOORD
  30. -INC SMELEME
  31. -INC SMMODEL
  32. POINTEUR IMODE3.IMODEL,IMODE4.IMODEL,IMODE5.IMODEL
  33. POINTEUR nomid1.NOMID,nomid2.NOMID
  34. -INC SMTABLE
  35. -INC SMLMOTS
  36. POINTEUR OPNLIN.MLMOTS
  37.  
  38. SEGMENT PLICON
  39. integer mlicon(NLCON),tlicon(NLCON)
  40. ENDSEGMENT
  41.  
  42. EXTERNAL LONG
  43. PARAMETER (NBFORM=19,NBCON=15,NBEXT=1,NBDIF=1)
  44. PARAMETER (N1MAX=300,N2MAX=200)
  45. PARAMETER (NLOMAX=5,NGELT=14)
  46.  
  47. DIMENSION LESMOD(N1MAX)
  48. CHARACTER*4 MOTEF(N2MAX),LESTEF(N2MAX)
  49. CHARACTER*4 MOCON(NBCON),MOEXT(NBEXT),MOINCO(NBDIF),MNLVAR(1)
  50. CHARACTER*4 MNLOCA(NLOMAX),MCTCT(4),MGAUSS(4),MOGELT(NGELT),MDISC
  51. CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,CMATE,PHAM
  52. CHARACTER*(LCONMO) CONM
  53. CHARACTER*(LOCOMP) MOPRID,MDIINC,MDIDUA
  54. CHARACTER*16 MOFORM(NBFORM),LESFOR(2),MOPROP(N1MAX),LESPRO(N1MAX)
  55. CHARACTER*16 MOTROP(3),MOTPRO
  56. CHARACTER*(LOCHAI) LMOLIB,LMOFCT
  57.  
  58. LOGICAL LOGRE,LOGIN,LMENLX,LMEVIX,LOSTAT,LOMELA,LMOEXT,LOBBAR
  59. LOGICAL LONAVI
  60.  
  61. C=DEB==== FORMULATION HHO ==== Declarations particulieres ==============
  62. PARAMETER (NMHHO=2)
  63. CHARACTER*4 mcHHO(NMHHO)
  64. CHARACTER*(LOCHAI) chaHHO
  65. LOGICAL loHHO
  66. DATA mcHHO / 'HHO_','HHO ' /
  67. C=FIN==== FORMULATION HHO ==============================================
  68. DATA MGAUSS /'EPAI' , 'RIGI' , 'MASS' ,'CONT'/
  69. c DATA MDERIV/'LINEAIRE ','QUADRATIQUE ',
  70. c & 'TRUESDELL ','JAUMANN ',
  71. c & 'UTILISATEUR ','FEFP '/
  72. C----------------------------------------------------------------------C
  73. C DEFINITION DES NOMS DE FORMULATIONS C
  74. C----------------------------------------------------------------------C
  75. DATA MOFORM /
  76. & 'THERMIQUE ','MECANIQUE ','LIQUIDE ',
  77. & 'POREUX ','DARCY ','CONTACT ',
  78. & 'MAGNETODYNAMIQUE','NAVIER_STOKES ','MELANGE ',
  79. & 'EULER ','FISSURE ','LIAISON ',
  80. & 'THERMOHYDRIQUE ','ELECTROSTATIQUE ','DIFFUSION ',
  81. & 'CHARGEMENT ','METALLURGIE ','CHANGEMENT_PHASE',
  82. & 'CONTRAINTE ' /
  83.  
  84. C (fdp) Ajout d'un nouveau mot clef 'LIBRE' ou 'LIE' pour les JOI1
  85. DATA MOCON / 'CONS','INTE','DPGE','PHAS','STAT','LCOI','LCOS',
  86. & 'LIBR','LIE ','NON_','LINE','CHPO','GAP7','COMP',
  87. & 'EPSI'/
  88. DATA MOEXT / 'PARA' /
  89. DATA MOINCO / 'INCO' /
  90. DATA MNLVAR / 'V_MO' /
  91. DATA MCTCT / 'MESC','FAIB','SYME','MORT' /
  92. DATA MOGELT / 'BBAR',
  93. & 'QUAF','LINE','MACR','LINB',
  94. & 'LICE','LIMS','LBMS','MCCE','MCP1','MCMS',
  95. & 'QFCE','QFP1','QFMS' /
  96.  
  97. LCVAR = 0
  98. LCMAT = 0
  99. LCMAF = 0
  100. LCPAR = 0
  101. NBGA = 10
  102. NBDANG = 3
  103. ICAVIT = 0
  104. ISYME = 0
  105. IFACAF = 0
  106. INLOC = 0
  107. LULVIA = 0
  108. C=DEB==== FORMULATION HHO ==== Initialisations particulieres ===========
  109. loHHO = .FALSE.
  110. C=FIN==== FORMULATION HHO ==============================================
  111. LMEVIX = .FALSE.
  112. LMENLX = .FALSE.
  113. LMOEXT = .FALSE.
  114. LOBBAR = .FALSE.
  115. LONAVI = .FALSE.
  116. ICONV = 0
  117. IRAYE = 0
  118. IPHAS = 0
  119. IPMMEL = 0
  120. JLMOT1 = 0
  121. JLMOT2 = 0
  122. mmode2 = 0
  123. IPTABL = 0
  124. IPTABS = 0
  125. IPTABM = 0
  126. IPTBMO = 0
  127. IPTBDM = 0
  128. IPTMOD = 0
  129. IPGEOM = 0
  130. IPGEO2 = 0
  131. C ==================================================================
  132. C 0- Acquisition des tables ou maillage
  133. C ==================================================================
  134. C Lecture d'une table BASE_MODALE
  135. CALL LIRTAB('BASE_MODALE',IPTABL,0,IRET)
  136. IF (IERR.NE.0) RETURN
  137. IF (IRET.GT.0) THEN
  138. IPTBMO=IPTABL
  139. IVALIN=0
  140. XVALIN=REAL(0.D0)
  141. LOGIN=.TRUE.
  142. IOBIN=0
  143. TAPIND='MOT '
  144. CHARIN='MODES'
  145. TYPOBJ='TABLE '
  146. CALL ACCTAB(IPTBMO,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  147. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  148. IF (IERR.NE.0) RETURN
  149. IPTBDM = IOBRE
  150. IVALIN=0
  151. XVALIN=REAL(0.D0)
  152. LOGIN=.TRUE.
  153. IOBIN=0
  154. TAPIND='MOT '
  155. CHARIN='MAILLAGE'
  156. TYPOBJ='MAILLAGE'
  157. CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  158. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  159. IF (IERR.NE.0) RETURN
  160. IPMAIL = IOBRE
  161. IVALIN=1
  162. XVALIN=REAL(0.D0)
  163. LOGIN=.TRUE.
  164. IOBIN=0
  165. TAPIND='ENTIER '
  166. CHARIN=' '
  167. TYPOBJ='TABLE'
  168. CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  169. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  170. IF (IERR.NE.0) RETURN
  171.  
  172. IPTMOD = IOBRE
  173. IVALIN=0
  174. XVALIN=REAL(0.D0)
  175. LOGIN=.TRUE.
  176. IOBIN=0
  177. TAPIND='MOT '
  178. TYPOBJ='POINT'
  179. CALL ACCTAB(IPTMOD,TAPIND,IVALIN,XVALIN,'POINT_REPERE',LOGIN,
  180. & IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  181. IF (IERR.NE.0) RETURN
  182. NBNN = 1
  183. NBELEM = 1
  184. NBSOUS = 0
  185. NBREF = 0
  186. SEGINI IPT8
  187. IPT8.ITYPEL = 1
  188. IPT8.NUM(1,1) = IOBRE
  189. IPGEOM = IPT8
  190. IRET = 0
  191. ENDIF
  192. C
  193. C Lecture d'une table STATIONNAIRE
  194. CALL LIRTAB('STATIONNAIRE',IPTABL,0,IRET)
  195. IF (IERR.NE.0) RETURN
  196. IF (IRET.GT.0) THEN
  197. IPTABS=IPTABL
  198. IVALIN=0
  199. XVALIN=REAL(0.D0)
  200. LOGIN=.TRUE.
  201. IOBIN=0
  202. TAPIND='MOT '
  203. CHARIN='MAILLAGE'
  204. TYPOBJ='TABLE '
  205. CALL ACCTAB(IPTABS,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  206. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  207. IF (IERR.NE.0) RETURN
  208. IPTABM = IOBRE
  209. IVALIN=1
  210. XVALIN=REAL(0.D0)
  211. LOGIN=.TRUE.
  212. IOBIN=0
  213. TAPIND='ENTIER '
  214. CHARIN=' '
  215. TYPOBJ='MAILLAGE'
  216. CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  217. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  218. IF (IERR.NE.0) RETURN
  219. IPGEOM = IOBRE
  220. IRET = 0
  221. ENDIF
  222. C
  223. C Lecture d'une TABLE de sous-type MAILLAGE
  224. IF (IPTABM.EQ.0) THEN
  225. CALL LIRTAB('MAILLAGE',IPTABL,0,IRET)
  226. IF (IERR.NE.0) RETURN
  227. IF (IRET.GT.0) THEN
  228. IPTABM = IPTABL
  229. IVALIN=1
  230. XVALIN=REAL(0.D0)
  231. LOGIN=.TRUE.
  232. IOBIN=0
  233. TAPIND='ENTIER '
  234. CHARIN=' '
  235. TYPOBJ='MAILLAGE'
  236. CALL ACCTAB(IPTABM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  237. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  238. IF (IERR.NE.0) RETURN
  239. IPGEOM = IOBRE
  240. IRET = 0
  241. ENDIF
  242. ENDIF
  243. C
  244. C Lecture d'un MAILLAGE ou d'une TABLE de sous-type DOMAINE
  245. CALL LIRTAB('DOMAINE',IPTABL,0,IRET)
  246. IF (IERR.NE.0) RETURN
  247. IF (IPTABL.GT.0) THEN
  248. IVALIN=0
  249. XVALIN=REAL(0.D0)
  250. LOGIN=.TRUE.
  251. IOBIN=0
  252. TAPIND='MOT '
  253. CHARIN='MAILLAGE'
  254. TYPOBJ='MAILLAGE'
  255. CALL ACCTAB(IPTABL,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  256. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  257. IF (IERR.NE.0) RETURN
  258. IPGEOM = IOBRE
  259. ENDIF
  260. C
  261. C Lecture d'un MAILLAGE (cas general) :
  262. IF (IPGEOM.LE.0) THEN
  263. CALL LIROBJ('MAILLAGE',IPGEOM,1,IRET)
  264. IF (IERR.NE.0) RETURN
  265. ENDIF
  266. C
  267. C Verification de l'unicite des elements
  268. IPT1 = IPGEOM
  269. CALL UNIQMA(IPT1,NBDI1,0)
  270. IF (NBDI1.NE.0) THEN
  271. MOTERR(1:8)='MAILLAGE'
  272. CALL ERREUR(1019)
  273. RETURN
  274. ENDIF
  275. C ==================================================================
  276. C 1- Identification de la formulation : FORMOD
  277. C ==================================================================
  278. C NFOR = 1 => Formulation simple
  279. C NFOR = 2 => Formulation couplee
  280. NFOR =0
  281. ICOND=1
  282. CALL MESLIR(-182)
  283.  
  284. 51 CONTINUE
  285. CALL LIRMOT(MOFORM,NBFORM,IPFORM,ICOND)
  286. IF (IERR.NE.0) RETURN
  287. IF (IPFORM.EQ.0) GOTO 52
  288. C
  289. NFOR=NFOR+1
  290. IF (NFOR.GT.2) THEN
  291. CALL ERREUR(251)
  292. RETURN
  293. ENDIF
  294. LESFOR(NFOR)=MOFORM(IPFORM)
  295. ICOND=0
  296. CALL MESLIR(-181)
  297. GOTO 51
  298. 52 CONTINUE
  299. C
  300. IF (NFOR.EQ.1) THEN
  301. IF (LESFOR(1).EQ.'THERMIQUE') THEN
  302. CALL MODEL1(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  303. ELSE IF(LESFOR(1).EQ.'MECANIQUE') THEN
  304. CALL MODEL2(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  305. ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN
  306. CALL MODEL3(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  307. ELSE IF(LESFOR(1).EQ.'POREUX') THEN
  308. CALL MODEL6(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  309. ELSE IF(LESFOR(1).EQ.'DARCY') THEN
  310. CALL MODEL7(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  311. ELSE IF(LESFOR(1).EQ.'CONTACT') THEN
  312. CALL MODEL8(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  313. ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  314. CALL MODE10(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  315. ELSE IF(LESFOR(1).EQ.'NAVIER_STOKES') THEN
  316. CALL MODE11(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  317. ELSE IF (LESFOR(1).EQ.'MELANGE') THEN
  318. CALL MODE12(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  319. DO i=1,N1MAX
  320. LESMOD(i)=0
  321. ENDDO
  322. ELSE IF(LESFOR(1).EQ.'EULER') THEN
  323. CALL MODE13(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  324. ELSE IF(LESFOR(1).EQ.'FISSURE') THEN
  325. CALL MODE14(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  326. ELSE IF(LESFOR(1).EQ.'LIAISON') THEN
  327. CALL MODE15(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  328. ELSE IF(LESFOR(1).EQ.'THERMOHYDRIQUE') THEN
  329. CALL MODE16(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  330. ELSE IF(LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN
  331. CALL MODE17(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  332. ELSE IF(LESFOR(1).EQ.'DIFFUSION ') THEN
  333. CALL MODE18(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  334. ELSE IF(LESFOR(1).EQ.'CHARGEMENT ') THEN
  335. CALL MODE19(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  336. ELSE IF(LESFOR(1).EQ.'METALLURGIE ') THEN
  337. cjk148537 : ce n'est pas l exemple a suivre
  338. CALL MODE21(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  339. ELSE IF(LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
  340. CALL MODE22(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  341. ELSE IF(LESFOR(1).EQ.'CONTRAINTE') THEN
  342. CALL MODE24(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  343. ELSE
  344. CALL ERREUR (251)
  345. ENDIF
  346. IF (IERR.NE.0) RETURN
  347. ELSE IF (NFOR.EQ.2) THEN
  348. IF ((LESFOR(1).EQ.'LIQUIDE'.AND.LESFOR(2).EQ.'MECANIQUE').OR.
  349. & (LESFOR(2).EQ.'LIQUIDE'.AND.LESFOR(1).EQ.'MECANIQUE')) THEN
  350. CALL MODEL5(NPROP,MOTEF,NBTEF,N2MAX)
  351. ELSE
  352. CALL ERREUR(251)
  353. ENDIF
  354. IF (IERR.NE.0) RETURN
  355. C
  356. MN3 = 12
  357. NOBMOD = 0
  358. NMAT = 0
  359. GOTO 43
  360. ENDIF
  361. C ==================================================================
  362. C 2- Identification du type de materiau : MATMOD
  363. C ==================================================================
  364. C NMAT = 0 => Valeur par defaut
  365. C NMAT /= 0 => Decrypter le contenu des LESPRO
  366. NMAT = 0
  367. IF (IPTABM.GT.0.AND.IPTABS.EQ.0) GOTO 674
  368. CALL MESLIR(-180)
  369. C
  370. 41 CONTINUE
  371. IF (NMAT.NE.0) CALL MESLIR(-179)
  372. CALL LIRMOT(MOPROP,NPROP,LAPROP,0)
  373. IF (IERR.NE.0) RETURN
  374. IF (LAPROP.EQ.0) GOTO 42
  375. C
  376. NMAT=NMAT+1
  377. LESPRO(NMAT)=MOPROP(LAPROP)
  378. CC WRITE(*,*) 'NMAT ',LESPRO(NMAT),NMAT
  379. GOTO 41
  380. 42 CONTINUE
  381. C
  382. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  383. C Formulation THERMIQUE
  384. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  385. IF (LESFOR(1).EQ.'THERMIQUE ') THEN
  386. C
  387. MN3 = 1
  388. NOBMOD = 0
  389. C
  390. C Comportement par defaut
  391. IF (NMAT.EQ.0) THEN
  392. NMAT = 2
  393. LESPRO(1)='ISOTROPE '
  394. LESPRO(2)='CONDUCTION '
  395. ELSE
  396. C
  397. C Comportement SOURCE
  398. C ------------------------
  399. CALL PLACE(LESPRO,NMAT,IPLAC,'SOURCE ')
  400. IF (IPLAC.EQ.0) GOTO 113
  401. C
  402. C Liste des EF disponibles pour les SOURCES
  403. CALL MODE23(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  404. C
  405. CALL PLACE(LESPRO,NMAT,IPLAC,'GAUSSIENNE ')
  406. IF (IPLAC.NE.0) THEN
  407. IF (IDIM.EQ.1) THEN
  408. INTERR(1) = IDIM
  409. CALL ERREUR(1104)
  410. RETURN
  411. ENDIF
  412. DO i=2,NMAT
  413. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
  414. IF ((i.EQ.2).AND.(IPLAC.EQ.0)) THEN
  415. NMAT=NMAT+1
  416. LESPRO(NMAT)='SPHERIQUE '
  417. ELSE IF (IPLAC.EQ.4) THEN
  418. IF (IDIM.LT.3) THEN
  419. INTERR(1)=IDIM
  420. CALL ERREUR(709)
  421. RETURN
  422. ENDIF
  423. ENDIF
  424. ENDDO
  425. ENDIF
  426. GOTO 112
  427. C
  428. 113 CONTINUE
  429. C
  430. C "Tropie"
  431. CALL MODTHE(MOTROP,NTROP)
  432. CALL PLACE(MOTROP,NTROP,IPLAC,LESPRO(1))
  433. IF (IPLAC.EQ.0) THEN
  434. DO i=NMAT,1,-1
  435. LESPRO(i+1)=LESPRO(i)
  436. ENDDO
  437. NMAT=NMAT+1
  438. LESPRO(1)='ISOTROPE '
  439. ENDIF
  440.  
  441. IF (NMAT.LT.2) THEN
  442. CALL PLACE(LESPRO,NMAT,IPLAC,'CONDUCTION ')
  443. IF (IPLAC.EQ.0) THEN
  444. NMAT=NMAT+1
  445. LESPRO(NMAT)='CONDUCTION'
  446. ENDIF
  447. ENDIF
  448. C
  449. C Comportement ADVECTION
  450. C ------------------------
  451. CALL PLACE(LESPRO,NMAT,IADVE,'ADVECTION ')
  452. CALL PLACE(LESPRO,NMAT,IPHAS,'PHASE ')
  453. IF ((IADVE+IPHAS).EQ.0) GOTO 110
  454. CALL PLACE(LESPRO,NMAT,IPLAC,'CONDUCTION ')
  455. IF (IPLAC.EQ.0) THEN
  456. NMAT=NMAT+1
  457. LESPRO(NMAT)='CONDUCTION '
  458. ENDIF
  459. 110 CONTINUE
  460. C
  461. C Comportement CONVECTION
  462. C ------------------------
  463. CALL PLACE(LESPRO,NMAT,IPLAC,'CONVECTION ')
  464. IF (IPLAC.EQ.0) GOTO 111
  465. ICONV=IPLAC
  466. C
  467. C Liste des EF disponibles pour la CONVECTION
  468. CALL MODEL4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  469. C
  470. 111 CONTINUE
  471. C
  472. C Comportement RAYONNEMENT
  473. C ------------------------
  474. CALL PLACE(LESPRO,NMAT,IPLAC,'RAYONNEMENT ')
  475. IF (IPLAC.EQ.0) GOTO 112
  476. IRAYE=IPLAC
  477. C
  478. C Liste des EF disponibles pour le RAYONNEMENT
  479. CALL MODEL9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX)
  480. C
  481. DO i=2,NMAT
  482. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
  483. C
  484. IF (MOPROP(IPLAC).EQ.'CAVITE ') THEN
  485. ICAVIT=1
  486. C
  487. ELSE IF (MOPROP(IPLAC).EQ.'FAC_A_FAC ') THEN
  488. IFACAF=1
  489. CALL LIROBJ('MAILLAGE',IPFAC1,1,IRETOU)
  490. IF(IERR.NE.0) RETURN
  491. CALL LIROBJ('MAILLAGE',IPFAC2,1,IRETOU)
  492. IF(IERR.NE.0) RETURN
  493. CALL LIROBJ('MAILLAGE',IPFAC3,1,IRETOU)
  494. IF(IERR.NE.0) RETURN
  495. CALL LIROBJ('MMODEL' ,IMOCO ,1,IRETOU)
  496. IF(IERR.NE.0) RETURN
  497. CALL ACTOBJ('MAILLAGE',IPFAC1,1)
  498. CALL ACTOBJ('MAILLAGE',IPFAC2,1)
  499. CALL ACTOBJ('MAILLAGE',IPFAC3,1)
  500. CALL ACTOBJ('MMODEL' ,IMOCO,1)
  501. IF (IERR.NE.0) RETURN
  502. C
  503. ELSE IF (MOPROP(IPLAC).EQ.'SYMETRIE ') THEN
  504. ISYME=1
  505. CALL LIROBJ('POINT',IPP1,1,IRETOU)
  506. IF(IERR.NE.0) RETURN
  507. CALL LIROBJ('POINT',IPP2,1,IRETOU)
  508. IF(IDIM.EQ.3)CALL LIROBJ('POINT',IPP3,1,IRETOU)
  509. IF(IERR.NE.0) RETURN
  510. C
  511. ELSE IF (MOPROP(IPLAC).EQ.'NGAU ') THEN
  512. CALL LIRENT(NBGA,1,IRETOU)
  513. IF(IERR.NE.0) RETURN
  514. C
  515. ELSE IF (MOPROP(IPLAC).EQ.'DANG ') THEN
  516. CALL LIRENT( NBDANG,1,IRETOU)
  517. IF(IERR.NE.0) RETURN
  518. C
  519. ENDIF
  520. ENDDO
  521. NOBMOD = 2*ICAVIT+ISYME*IDIM+IFACAF*4
  522. C
  523. 112 CONTINUE
  524. ENDIF
  525. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  526. C Formulation MECANIQUE/POREUX
  527. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  528. ELSE IF (LESFOR(1).EQ.'MECANIQUE ' .OR.
  529. & LESFOR(1).EQ.'POREUX ') THEN
  530. C
  531. MN3 = 12
  532. NOBMOD = 0
  533. C
  534. C Comportement par defaut
  535. IF ((NMAT.EQ.0).OR.(NMAT.EQ.1)) THEN
  536. NMAT=2
  537. LESPRO(1)='ELASTIQUE '
  538. LESPRO(2)='ISOTROPE '
  539. ELSE
  540. C
  541. C Comportement lineaire
  542. CALL MODELA(MOPROP,NMOD)
  543. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(2))
  544. IF (IPLAC.EQ.0) THEN
  545. DO i=NMAT,2,-1
  546. LESPRO(i+1)=LESPRO(i)
  547. ENDDO
  548. LESPRO(2)='ISOTROPE'
  549. NMAT=NMAT+1
  550. ENDIF
  551. C
  552. C Comportement non lineaire
  553. CALL MODNLI(MOPROP,NMOD)
  554. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
  555. IF (IPLAC.EQ.1) THEN
  556. C Par defaut : PLASTIQUE ISOTROPE
  557. NMAT=NMAT+1
  558. LESPRO(NMAT)='ISOTROPE'
  559. ELSE IF (IPLAC.EQ.2) THEN
  560. C Par defaut : FLUAGE NORTON
  561. NMAT=NMAT+1
  562. LESPRO(NMAT)='NORTON'
  563. ELSE IF (IPLAC.EQ.3) THEN
  564. C Par defaut : VISCOPLASTIQUE ONERA
  565. NMAT=NMAT+1
  566. LESPRO(NMAT)='ONERA'
  567. ELSE IF (IPLAC.EQ.4) THEN
  568. C Par defaut : ENDOMMAGEMENT MAZARS
  569. NMAT=NMAT+1
  570. LESPRO(NMAT)='MAZARS'
  571. ELSE IF (IPLAC.EQ.5) THEN
  572. C Par defaut : ENDOMMAGEMENT PLASTIQUE P/Y
  573. NMAT=NMAT+1
  574. LESPRO(NMAT)='PSURY'
  575. ELSE IF (IPLAC.EQ.6) THEN
  576. C Pas de comportement par defaut pour 'NON_LINEAIRE'
  577. CALL ERREUR(945)
  578. RETURN
  579. ELSE IF (IPLAC.EQ.7) THEN
  580. C Pas de comportement par defaut en 'MECANIQUE'
  581. IF (LESFOR(1).EQ.'MECANIQUE') CALL ERREUR(946)
  582. IF (LESFOR(1).EQ.'POREUX') CALL ERREUR(251)
  583. RETURN
  584. ENDIF
  585. C
  586. C Lois externes : lecture d'arguments supplementaires
  587. CALL PLACE(LESPRO,NMAT,IPLAC,'VISCO_EXTERNE ')
  588. LMEVIX=(IPLAC.NE.0)
  589. CALL PLACE(LESPRO,NMAT,IPLAC,'NON_LINEAIRE ')
  590. IF (IPLAC.NE.0) THEN
  591. CALL PLACE(LESPRO,NMAT,IPLAC,'UTILISATEUR ')
  592. LMENLX=(IPLAC.NE.0)
  593. ENDIF
  594. LMOEXT=LMEVIX.OR.LMENLX
  595. C
  596. CALL PLACE(LESPRO,NMAT,IPLAC,'MODAL ')
  597. IF (IPLAC.NE.0) THEN
  598. IF (IPTMOD.GT.0) NOBMOD = 1
  599. IF (IPMOD3.GT.0) NOBMOD = NOBMOD + 1
  600. ENDIF
  601. ENDIF
  602. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  603. C Formulation LIQUIDE
  604. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  605. ELSE IF (LESFOR(1).EQ.'LIQUIDE ') THEN
  606. C
  607. MN3 = 12
  608. NOBMOD = 0
  609. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  610. C Formulation DARCY
  611. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  612. ELSE IF (LESFOR(1).EQ.'DARCY ') THEN
  613. C
  614. MN3 = 2
  615. NOBMOD = 0
  616. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  617. C Formulation CONTACT
  618. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  619. ELSE IF (LESFOR(1).EQ.'CONTACT ') THEN
  620. C
  621. MN3 = 1
  622. NOBMOD = 3
  623. C
  624. ITCO=1
  625. IFRT=0
  626. IMUL=0
  627. IF (NMAT.EQ.0) THEN
  628. NMAT=1
  629. LESPRO(1)='UNILATERAL '
  630. ELSE
  631. CALL PLACE(LESPRO,NMAT,IPLAC,'UNILATERAL ')
  632. IF (IPLAC.EQ.0) THEN
  633. DO i=NMAT,1,-1
  634. LESPRO(i+1)=LESPRO(i)
  635. ENDDO
  636. NMAT=NMAT+1
  637. LESPRO(1)='UNILATERAL '
  638. ENDIF
  639. C
  640. CALL PLACE(LESPRO,NMAT,IPLAC,'FROCABLE ')
  641. IF (IPLAC.NE.0) ITCO = 0
  642. CALL PLACE(LESPRO,NMAT,IPLAC,'FROTTANT ')
  643. IF (IPLAC.NE.0) IMUL = 3
  644. CALL PLACE(LESPRO,NMAT,IPLAC,'COULOMB ')
  645. IF (IPLAC.NE.0) IFRT = 1
  646. C
  647. ENDIF
  648. C
  649. IF (ITCO.EQ.1) THEN
  650. C Mot-cle donnant la formulation
  651. CALL LIRMOT(MCTCT,4,ITCO,0)
  652. IF(ITCO.EQ.0) ITCO=1
  653. C Mortar : uniquement disponible en 2D
  654. IF ((ITCO.EQ.4) .AND. (IDIM.NE.2)) THEN
  655. INTERR(1) = IDIM
  656. CALL ERREUR(1104)
  657. RETURN
  658. ENDIF
  659. ENDIF
  660. C
  661. C Lecture du second maillage
  662. CALL LIROBJ('MAILLAGE',IPGEO2,1,IRETOU)
  663. IF (IERR.NE.0) RETURN
  664. C
  665. C Creation des mult. de Lagrange
  666. IPGEO1=IPGEOM
  667. IF (ITCO.EQ.0) THEN
  668. IPGEOX=IPGEO1
  669. CALL MOCON1(IPGEOX,IMUL,ITCO)
  670. ELSE
  671. IPGEOX=IPGEO2
  672. CALL MOCON1(IPGEOX,IMUL,ITCO)
  673. IF (IERR.NE.0) RETURN
  674. IF (ITCO.EQ.2) THEN
  675. IP2=IPGEO1
  676. CALL MOCON1(IP2,IMUL,ITCO)
  677. IF(IERR.NE.0) RETURN
  678. IP1=IPGEOX
  679. CALL FUSE(IP1,IP2,IRET,.FALSE.)
  680. IF(IERR.NE.0) RETURN
  681. IPGEOX=IRET
  682. ELSE IF (ITCO.EQ.3) THEN
  683. IPGEOY=IPGEO1
  684. CALL MOCON1(IPGEOY,IMUL,ITCO)
  685. IF(IERR.NE.0) RETURN
  686. ENDIF
  687. ENDIF
  688. IPGEOM=IPGEOX
  689. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  690. C Formulation MAGNETODYNAMIQUE
  691. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  692. ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN
  693. C
  694. MN3 = 12
  695. NOBMOD = 0
  696. C
  697. C Comportement par defaut
  698. IF ((NMAT.EQ.0).OR.(NMAT.EQ.1)) THEN
  699. NMAT=2
  700. LESPRO(1)='POTENTIEL_VECTEU'
  701. LESPRO(2)='ISOTROPE '
  702. ENDIF
  703. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  704. C Formulation NAVIER_STOKES/EULER
  705. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  706. ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES ' .OR.
  707. & LESFOR(1).EQ.'EULER ') THEN
  708. C
  709. MN3 = 2
  710. NOBMOD = 0
  711. C
  712. IF (NMAT.EQ.0) THEN
  713. NMAT = 1
  714. LESPRO(NMAT)='NEWTONIEN'
  715. ELSE
  716. DO i=1,NMAT
  717. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
  718. IF (IPLAC.EQ.4) THEN
  719. MN3 = 12
  720. NOBMOD = 1
  721. ENDIF
  722. ENDDO
  723. ENDIF
  724. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  725. C Formulation MELANGE
  726. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  727. ELSE IF (LESFOR(1).EQ.'MELANGE ') THEN
  728. C
  729. MN3 = 7
  730. NOBMOD = 0
  731. C
  732. IF (NMAT.EQ.0) THEN
  733. NMAT = 1
  734. LESPRO(1)='PARALLELE '
  735. ELSE
  736. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(1))
  737. IF (IPLAC.EQ.0) THEN
  738. DO i=NMAT,1,-1
  739. LESPRO(i+1)=LESPRO(i)
  740. ENDDO
  741. NMAT=NMAT+1
  742. LESPRO(1)='PARALLELE '
  743. ENDIF
  744. ENDIF
  745. C
  746. CALL LIROBJ('MMODEL',IPMOD,0,IOK)
  747. IF (IERR.NE.0) RETURN
  748. IF (IOK.EQ.1) THEN
  749. CALL ACTOBJ('MMODEL',IPMOD,1)
  750. IF (IERR.NE.0) RETURN
  751. LESMOD(1)=IPMOD
  752. ENDIF
  753. C
  754. CALL PLACE(LESPRO,NMAT,IPARA,'PARALLELE ')
  755. CALL PLACE(LESPRO,NMAT,ISERI,'SERIE ')
  756. IF ((IPARA+ISERI).NE.0) THEN
  757. IF (IPMOD.LE.0) THEN
  758. CALL ERREUR(21)
  759. RETURN
  760. ENDIF
  761. IPMMEL = IPMOD
  762. MMODE1 = IPMOD
  763. NOBMOD = MMODE1.KMODEL(/1)
  764. ENDIF
  765. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  766. C Formulation FISSURE
  767. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  768. ELSE IF (LESFOR(1).EQ.'FISSURE ') THEN
  769. C
  770. MN3 = 2
  771. NOBMOD = 0
  772. C
  773. IF (NMAT.EQ.0) THEN
  774. NMAT = 3
  775. LESPRO(1)='MASS'
  776. LESPRO(2)='PARF'
  777. LESPRO(3)='POISEU_BLASIUS'
  778. ENDIF
  779. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  780. C Formulation LIAISON
  781. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  782. ELSE IF (LESFOR(1).EQ.'LIAISON ') THEN
  783. C
  784. MN3 = 12
  785. NOBMOD = 0
  786. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  787. C Formulation THERMOHYDRIQUE
  788. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  789. ELSE IF (LESFOR(1).EQ.'THERMOHYDRIQUE ') THEN
  790. C
  791. MN3 = 12
  792. NOBMOD = 0
  793. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  794. C Formulation ELECTROSTATIQUE
  795. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  796. ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN
  797. C
  798. MN3 = 12
  799. NOBMOD = 0
  800. C
  801. IPROP = 3
  802. IF (IDIM.EQ.1) IPROP = 1
  803. CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1))
  804. IF (IPLAC.EQ.0) THEN
  805. DO i=NMAT,1,-1
  806. LESPRO(i+1)=LESPRO(i)
  807. ENDDO
  808. NMAT=NMAT+1
  809. LESPRO(1)='ISOTROPE '
  810. ENDIF
  811. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  812. C Formulation DIFFUSION
  813. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  814. ELSE IF (LESFOR(1).EQ.'DIFFUSION ') THEN
  815. C
  816. MN3 = 12
  817. NOBMOD = 1
  818. C
  819. C Comportement par defaut
  820. IF (NMAT.EQ.0) THEN
  821. NMAT = 2
  822. LESPRO(1)='ISOTROPE '
  823. LESPRO(2)='FICK '
  824. ELSE
  825. C
  826. C "Tropie"
  827. CALL MODTHE(MOTROP,NTROP)
  828. CALL PLACE(MOTROP,NTROP,IPLAC,LESPRO(1))
  829. IF (IPLAC.EQ.0) THEN
  830. DO i=NMAT,1,-1
  831. LESPRO(i+1)=LESPRO(i)
  832. ENDDO
  833. NMAT=NMAT+1
  834. LESPRO(1)='ISOTROPE '
  835. ENDIF
  836. C
  837. CALL MODDIF(MOPROP,NMOD)
  838. CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT))
  839. IF (IPLAC.EQ.0) THEN
  840. NMAT=NMAT+1
  841. LESPRO(NMAT)='FICK '
  842. ELSE IF (MOPROP(IPLAC).EQ.'UTILISATEUR ') THEN
  843. LMOEXT=.TRUE.
  844. ELSE IF (MOPROP(IPLAC).EQ.'SORET ') THEN
  845. CHARIN = 'T '
  846. C Lecture du mot-cle 'PARA_LOI' et donnees associees
  847. CALL LIRMOT(MOEXT,1,LEXT,0)
  848. IF (IERR.NE.0) RETURN
  849. IF (LEXT.EQ.1) THEN
  850. CALL LIROBJ('LISTMOTS',mlmots,0,IRET)
  851. IF (IERR.NE.0) RETURN
  852. IF (IRET.EQ.0) THEN
  853. CALL LIRCHA(CHARIN,1,IRETI)
  854. IF (IERR.NE.0) RETURN
  855. IRETI=LONG(CHARIN)
  856. IF (IRETI.EQ.0) CALL ERREUR(643)
  857. ELSE
  858. SEGACT,mlmots
  859. NBCOMP = mots(/2)
  860. IF (NBCOMP.EQ.0) THEN
  861. CALL ERREUR(964)
  862. ELSE
  863. CHARIN = MOTS(1)
  864. IRETI = LONG(CHARIN)
  865. IF (IRETI.EQ.0) CALL ERREUR(643)
  866. ENDIF
  867. ENDIF
  868. IF (IERR.NE.0) RETURN
  869. IRETMA = 6
  870. IF (IRETI.GT.IRETMA) THEN
  871. INTERR(1) = IRETMA
  872. MOTERR(1:8) = CHARIN(1:IRETI)
  873. CALL ERREUR(-353)
  874. ENDIF
  875. IRETI = MIN(IRETI,IRETMA)
  876. CHARIN(IRETI+1:8) = ' '
  877. ENDIF
  878. JGM = 1
  879. JGN = LOCOMP
  880. SEGINI,mlmots
  881. mots(1) = CHARIN
  882. LCPAR = mlmots
  883. ENDIF
  884. ENDIF
  885. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  886. C Formulation CHARGEMENT
  887. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  888. ELSE IF (LESFOR(1).EQ.'CHARGEMENT ') THEN
  889. C
  890. MN3 = 12
  891. NOBMOD = 0
  892. C
  893. IF (NMAT.EQ.0) THEN
  894. CALL ERREUR(251)
  895. RETURN
  896. ENDIF
  897. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  898. C Formulation METALLURGIE
  899. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  900. ELSE IF (LESFOR(1).EQ.'METALLURGIE ') THEN
  901. C
  902. IF (NMAT.NE.4) THEN
  903. CALL ERREUR(5)
  904. RETURN
  905. ENDIF
  906. C
  907. MN3 = 2
  908. NOBMOD = 4
  909. C
  910. DO i=1,4
  911. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(i))
  912. IF (IPLAC.EQ.0) THEN
  913. CALL ERREUR(1077)
  914. RETURN
  915. ENDIF
  916. CALL LIROBJ('LISTMOTS',LUMOTS,1,IRETOU)
  917. MLMOTS = LUMOTS
  918. SEGACT,MLMOTS*NOMOD
  919. IF (IPLAC.EQ.1) THEN
  920. LCVAR = MLMOTS
  921. MLMOT1 = MLMOTS
  922. NB_PHA = MLMOTS.MOTS(/2)
  923. ELSE IF (IPLAC.EQ.2) THEN
  924. IREACT = MLMOTS
  925. MLMOT2 = MLMOTS
  926. NB_REA = MLMOTS.MOTS(/2)
  927. ELSE IF (IPLAC.EQ.3) THEN
  928. IPRODU = MLMOTS
  929. MLMOT3 = MLMOTS
  930. NB_PRO = MLMOTS.MOTS(/2)
  931. ELSE IF (IPLAC.EQ.4) THEN
  932. LCMAT = MLMOTS
  933. NB_TYP = MLMOTS.MOTS(/2)
  934. DO JJ = 1,NB_TYP
  935. LESPRO(JJ) = MLMOTS.MOTS(JJ)
  936. ENDDO
  937. ENDIF
  938. ENDDO
  939. C
  940. C Un type de reaction definit pour chaque reaction
  941. IF( NB_TYP .NE. NB_PRO ) THEN
  942. CALL ERREUR(1077)
  943. RETURN
  944. ENDIF
  945. C
  946. C Autant de produits que de reactifs
  947. IF( NB_PRO .NE. NB_REA ) THEN
  948. CALL ERREUR(1078)
  949. RETURN
  950. ENDIF
  951. C
  952. CCCC On initialise le MLMOT1 des PHASES si celui ci n'a pas ete lu
  953. icompt = 0
  954. CCCC IF(LCVAR.LE. 0) THEN
  955. CCCC icompt = 1
  956. CCCC NB_PHA = NB_REA + NB_PRO
  957. CCCC JGN = LOCOMP
  958. CCCC JGM = NB_PHA
  959. CCCC SEGINI, MLMOT1
  960. CCCC LCVAR = MLMOT1
  961. CCCC On remplira ensuite MATMOD() avec lespro()
  962. CCCC lespro(1) = MOPROP(1)
  963. CCCC endif
  964.  
  965. DO IPHA = 1, NB_PRO
  966.  
  967. C Produits differents du reactif pour chaque reaction
  968. IF( MLMOT2.MOTS(IPHA) .EQ. MLMOT3.MOTS(IPHA) ) THEN
  969. MOTERR(1:4)=MLMOT2.MOTS(IPHA)
  970. MOTERR(5:8)=MLMOT3.MOTS(IPHA)
  971. CALL ERREUR(1075)
  972. RETURN
  973. ENDIF
  974. C
  975. CALL PLACE(MLMOT1.MOTS,NB_PHA,IRPHAS,MLMOT2.MOTS(IPHA))
  976. CALL PLACE(MLMOT1.MOTS,NB_PHA,IPPHAS,MLMOT3.MOTS(IPHA))
  977. C SI LE NOM DU PRODUIT OU DU REACTIF N'A PAS ETE LU DANS LE
  978. C MLMOT1 DES PHASES :
  979. C ON LE RAJOUTE SI LCVAR N'AVAIT PAS ETE LU
  980. C ON EMET UNE ERREUR SINON
  981. IF (IRPHAS .EQ. 0) THEN
  982. IF( ICOMPT .GE. 1 ) THEN
  983. MLMOT1.MOTS(ICOMPT) = MLMOT2.MOTS(IPHA)
  984. ICOMPT = ICOMPT + 1
  985. ELSE
  986. MOTERR(1:4)=MLMOT2.MOTS(IPHA)
  987. CALL ERREUR(1080)
  988. RETURN
  989. ENDIF
  990. ENDIF
  991. IF (IPPHAS .EQ. 0) THEN
  992. IF( ICOMPT .GE. 1 ) THEN
  993. MLMOT1.MOTS(ICOMPT) = MLMOT3.MOTS(IPHA)
  994. ICOMPT = ICOMPT + 1
  995. ELSE
  996. MOTERR(1:4)=MLMOT3.MOTS(IPHA)
  997. CALL ERREUR(1080)
  998. RETURN
  999. ENDIF
  1000. ENDIF
  1001.  
  1002. ENDDO
  1003. C
  1004. CCCC On corrige la taille de MLMOT1 :
  1005. CCCC if( icompt .ge. 1 ) then
  1006. CCCC JGM = icompt - 1
  1007. CCCC JGN = MLMOT1.MOTS(/1)
  1008. CCCC SEGADJ, MLMOT1
  1009. CCCC endif
  1010.  
  1011. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1012. C Formulation CHANGEMENT_PHASE
  1013. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1014. ELSE IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
  1015. C
  1016. MN3 = 12
  1017. NOBMOD = 2
  1018. JGM = 2
  1019. C
  1020. IF (NMAT.EQ.0) THEN
  1021. NMAT=1
  1022. LESPRO(1)='PARFAIT '
  1023. ELSE
  1024. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(1))
  1025. IF (IPLAC.EQ.0) THEN
  1026. WRITE(*,*) 'PAS TROUVE LA FORMULATION PHASE'
  1027. CALL ERREUR(5)
  1028. RETURN
  1029. ELSE IF (IPLAC.EQ.2) THEN
  1030. JGM = 4
  1031. NOBMOD = 3
  1032. ENDIF
  1033. ENDIF
  1034. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1035. C Formulation CONTRAINTE
  1036. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1037. ELSE IF (LESFOR(1).EQ.'CONTRAINTE ') THEN
  1038. C
  1039. MN3 = 1
  1040. NOBMOD = 2
  1041. LACTR = 3
  1042. C
  1043. IF (NMAT.EQ.0) THEN
  1044. NMAT=1
  1045. LESPRO(1)='RELATION '
  1046. ELSE
  1047. CALL PLACE(MOPROP,NPROP,IPLAC,LESPRO(1))
  1048. IF (IPLAC.EQ.0) THEN
  1049. DO i=NMAT,1,-1
  1050. LESPRO(i+1)=LESPRO(i)
  1051. ENDDO
  1052. NMAT=NMAT+1
  1053. LESPRO(1)='RELATION '
  1054. ENDIF
  1055. ENDIF
  1056. C
  1057. CALL PLACE(LESPRO,NMAT,IPLAC,'ROTATION')
  1058. IF (IPLAC.NE.0) THEN
  1059. LACTR = IPLAC
  1060. NOBMOD=3
  1061. CALL MESLIR(0)
  1062. CALL LIROBJ('POINT',IP1,1,IOK)
  1063. IF (IDIM.EQ.3) THEN
  1064. NOBMOD=4
  1065. CALL LIROBJ('POINT',IP2,1,IOK)
  1066. IF (IERR.NE.0) RETURN
  1067. ENDIF
  1068. ENDIF
  1069. C
  1070. CALL PLACE(LESPRO,NMAT,IPLAC,'DEPLACEMENT')
  1071. IF (IPLAC.NE.0) THEN
  1072. LACTR = IPLAC
  1073. NOBMOD=3
  1074. CALL LIROBJ('POINT',IP1,1,IOK)
  1075. IF (IERR.NE.0) RETURN
  1076. ENDIF
  1077. C
  1078. IPGEOC=IPGEOM
  1079. IF (LACTR.EQ.1.OR.LACTR.EQ.2) CALL MOCON2(IPGEOC,IPT7)
  1080. IF (LACTR.EQ.3) CALL MOCON3(IPGEOC,IPT7)
  1081. IPGEOM=IPT7
  1082. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1083. ENDIF
  1084. C ==================================================================
  1085. C 3- Lecture eventuelle des types d'ELEMENTS FINIS a utiliser
  1086. C ==================================================================
  1087. 43 CONTINUE
  1088. C=DEB==== FORMULATION HHO ==== Cas particulier =========================
  1089. CALL LIRMOT(mcHHO,NMHHO,iHHO,0)
  1090. IF (IERR.NE.0) RETURN
  1091. IF (iHHO.NE.0) THEN
  1092. CALL REFUS
  1093. CALL LIRCHA(chaHHO,1,IRETI)
  1094. IF (IERR.NE.0) RETURN
  1095. loHHO = .TRUE.
  1096. END IF
  1097. C=FIN==== FORMULATION HHO ==============================================
  1098. C
  1099. ITEF=0
  1100. IF (NBTEF.EQ.0) GOTO 2
  1101. CALL MESLIR(-178)
  1102. C
  1103. C Lecture d'un Element Fini
  1104. 1 CONTINUE
  1105. CALL LIRMOT(NOMTP,LNOMTP,LETEF,0)
  1106. IF (IERR.NE.0) RETURN
  1107. IF (LETEF.EQ.0) GOTO 2
  1108. ITEF=ITEF+1
  1109. LESTEF(ITEF)=NOMTP(LETEF)
  1110. CALL MESLIR(-177)
  1111. GOTO 1
  1112. 2 CONTINUE
  1113. C
  1114. C Lecture d'un mot generique pour un type d'element Fini
  1115. IF (ITEF.EQ.0) THEN
  1116. CALL LIRMOT(MOGELT,NGELT,LETEF,0)
  1117. IF (IERR.NE.0) RETURN
  1118. IF (LETEF.EQ.0) GOTO 3
  1119. ITEF=ITEF+1
  1120. IF (MOGELT(LETEF).EQ.'BBAR') THEN
  1121. LOBBAR=.TRUE.
  1122. ELSE
  1123. LONAVI=.TRUE.
  1124. MDISC=MOGELT(LETEF)
  1125. ENDIF
  1126. ENDIF
  1127. 3 CONTINUE
  1128. C
  1129. C Mot-cle 'INCO' et noms d'inconnues primales et duales
  1130. CALL LIRMOT(MOINCO,NBDIF,LEXT,0)
  1131. C
  1132. IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
  1133. IF (LEXT.EQ.0) THEN
  1134. CALL ERREUR(1093)
  1135. RETURN
  1136. ENDIF
  1137. JGN =LOCOMP
  1138. SEGINI,MLMOT1
  1139. IPRIDU=MLMOT1
  1140. DO IMOT=1,JGM
  1141. CALL LIRCHA(MOPRID,1,ILONG)
  1142. IF (IERR.NE.0) RETURN
  1143. MLMOT1.MOTS(IMOT) = MOPRID
  1144. ENDDO
  1145. C
  1146. ELSE IF (LESFOR(1).EQ.'DIFFUSION ') THEN
  1147. IF (LEXT.EQ.0) THEN
  1148. MDIINC='CO '
  1149. MDIDUA='QCO '
  1150. ELSE
  1151. MDIINC=' '
  1152. MDIDUA='Q '
  1153. CHARIN=' '
  1154. CHARRE=' '
  1155. C
  1156. C Lecture sous forme de LISTMOTS ou MOTS
  1157. CALL LIROBJ('LISTMOTS',MLMOTS,0,IRET)
  1158. IF (IERR.NE.0) RETURN
  1159. IF (MLMOTS.NE.0) THEN
  1160. SEGACT,MLMOTS
  1161. NBCOMP = MOTS(/2)
  1162. IF (NBCOMP.NE.1) THEN
  1163. CALL ERREUR(643)
  1164. RETURN
  1165. ENDIF
  1166. CHARIN=MOTS(1)
  1167. CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETE)
  1168. IF (IERR.NE.0) RETURN
  1169. IF (MLMOTS.NE.0) THEN
  1170. SEGACT,MLMOTS
  1171. NBCOMP = MOTS(/2)
  1172. IF (NBCOMP.NE.1) THEN
  1173. CALL ERREUR(643)
  1174. RETURN
  1175. ENDIF
  1176. CHARRE=MOTS(1)
  1177. ENDIF
  1178. ELSE
  1179. CALL LIRCHA(CHARIN,1,IRETI)
  1180. IF (IERR.NE.0) RETURN
  1181. CALL LIRCHA(CHARRE,0,IRETE)
  1182. IF (IERR.NE.0) RETURN
  1183. ENDIF
  1184. C
  1185. C Verification sur la taille des inconnues
  1186. IRETMA = 6
  1187. IRETI = LONG(CHARIN)
  1188. IF (IRETI.EQ.0) THEN
  1189. CALL ERREUR(643)
  1190. RETURN
  1191. ENDIF
  1192. IF (IRETI.GT.IRETMA) THEN
  1193. INTERR(1) = IRETMA
  1194. MOTERR(1:8) = CHARIN(1:IRETI)
  1195. CALL ERREUR(-353)
  1196. ENDIF
  1197. IRETI = MIN(IRETI,IRETMA)
  1198. MDIINC(1:IRETI)=CHARIN(1:IRETI)
  1199. C
  1200. IF (IRETE.GT.0) THEN
  1201. IRETE = LONG(CHARRE)
  1202. IF (IRETE.EQ.0) THEN
  1203. CALL ERREUR(643)
  1204. RETURN
  1205. ENDIF
  1206. IRETMA = IRETMA + 2
  1207. IF (IRETE.GT.IRETMA) THEN
  1208. INTERR(1) = IRETMA
  1209. MOTERR(1:8) = CHARRE(1:IRETE)
  1210. CALL ERREUR(-353)
  1211. ENDIF
  1212. IRETE=MIN(IRETE,IRETMA)
  1213. MDIDUA(1:IRETE)=CHARRE(1:IRETE)
  1214. ELSE
  1215. MDIDUA(2:1+IRETI)=MDIINC(1:IRETI)
  1216. ENDIF
  1217. ENDIF
  1218. C
  1219. C Verification des noms de primale et duale lues
  1220. CALL VERMDI(MDIINC,MDIDUA)
  1221. IF (IERR.NE.0) RETURN
  1222.  
  1223. C On les place dans un LISTMOTS pour TYMODE et IVAMODE
  1224. JGN = LOCOMP
  1225. JGM = 2
  1226. SEGINI,MLMOT1
  1227. IPLRDI=MLMOT1
  1228. MLMOT1.MOTS(1) = MDIINC
  1229. MLMOT1.MOTS(2) = MDIDUA
  1230. C
  1231. ELSE
  1232. IF (LEXT.GT.0) THEN
  1233. CALL LIROBJ('LISTMOTS',JLMOT1,1,IRET)
  1234. IF (IERR.NE.0) RETURN
  1235. CALL LIROBJ('LISTMOTS',JLMOT2,1,IRET)
  1236. IF (IERR.NE.0) RETURN
  1237. MLMOT5 = JLMOT1
  1238. MLMOT6 = JLMOT2
  1239. SEGACT,MLMOT5,MLMOT6
  1240. IF (MLMOT5.MOTS(/2).NE.MLMOT6.MOTS(/2)) THEN
  1241. CALL ERREUR(26)
  1242. RETURN
  1243. ENDIF
  1244. NOBMOD = 2
  1245. ENDIF
  1246. ENDIF
  1247. C
  1248. C Loi UTILISATEUR : recuperer les informations supplementaires
  1249. IF (LMOEXT) THEN
  1250. CALL MODEXT(MOTPRO,LCPAR,LCMAT,LCVAR,
  1251. & LMOLOI,LMOPTR,LMOLIB,LMOLGB,LMOFCT,LMOLGT)
  1252. C
  1253. IF (LMOLOI.GT.0) NOBMOD = NOBMOD + 4
  1254. IF (LMEVIX) NOBMOD = NOBMOD + 1
  1255. C
  1256. C Donnee 'C_MATERIAU' manquante
  1257. IF (LMENLX) THEN
  1258. IF (LCMAT.EQ.0) THEN
  1259. CALL ERREUR(641)
  1260. RETURN
  1261. ENDIF
  1262. ENDIF
  1263. C
  1264. C Ajouter le numero ou le nom de la loi utilisateur
  1265. NMAT = NMAT + 1
  1266. LESPRO(NMAT) = MOTPRO
  1267. ENDIF
  1268. C ==================================================================
  1269. C 4- Lecture de mots-cles supplementaires
  1270. C ==================================================================
  1271. 674 CONTINUE
  1272. CONM = ' '
  1273. KCONS = 0
  1274. NGINT = 0
  1275. NGRIG = 0
  1276. NGMAS = 0
  1277. NGCON = 0
  1278. IPTGEN = 0
  1279. PHAM = ' '
  1280. IPMOD1 = 0
  1281. klcon = 0
  1282. plicon = 0
  1283. ILIE = 0
  1284. kbnlin = 0
  1285. IPMOD3 = 0
  1286. Cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  1287. JDERIV=0
  1288. C JDERIV=MEPSIL
  1289.  
  1290. 675 CONTINUE
  1291. CALL LIRMOT(MOCON,NBCON,LECON,0)
  1292. IF (LECON.EQ.0) GOTO 22
  1293. C
  1294. C 'CONS' : nom du constituant
  1295. IF (LECON.EQ.1) THEN
  1296. CALL LIRCHA(CONM,1,KCONS)
  1297. IF (IERR.NE.0) RETURN
  1298. C
  1299. C 'INTE' : nombre de points d'integration dans l'epaisseur
  1300. ELSE IF (LECON.EQ.2) THEN
  1301. i1foi = 1
  1302. 677 CONTINUE
  1303. LEGAUS=0
  1304. CALL LIRMOT(MGAUSS,4,LEGAUS,0)
  1305. IF (IERR.NE.0) RETURN
  1306. IF (I1FOI.NE.1.AND.LEGAUS.EQ.0) GOTO 676
  1307. CALL LIRENT(ITT,1,IRET)
  1308. IF (IERR.NE.0) RETURN
  1309. IF (ITT.LT.1) THEN
  1310. INTERR(1) = ITT
  1311. CALL ERREUR(36)
  1312. RETURN
  1313. ENDIF
  1314. if (legaus.eq.0 .or. legaus.eq.1) then
  1315. c itt doit etre impair (> 0)
  1316. IF (MOD(itt,2).EQ.0) THEN
  1317. call erreur(607)
  1318. return
  1319. ENDIF
  1320. NGINT = itt
  1321. endif
  1322. IF (LEGAUS.EQ.2) NGRIG = ITT
  1323. IF (LEGAUS.EQ.3) NGMAS = ITT
  1324. IF (LEGAUS.EQ.4) NGCON = ITT
  1325. IF (I1FOI.EQ.1.AND.LEGAUS.EQ.0) GOTO 676
  1326. I1FOI = 0
  1327. c INTE itt <=> INTE EPAI itt ; autres mots a ecrire
  1328. c Syntaxe de modeli non decrite :
  1329. c Si plusieurs mots de MGAUSS
  1330. c INTE MOT1 itt1 MOT2 itt2 ... ; (couples MOTi iiti obligatoires)
  1331. goto 677
  1332. 676 CONTINUE
  1333. C
  1334. C 'DPGE' : point support des deformations planes generalisees
  1335. ELSE IF (LECON.EQ.3) THEN
  1336. CALL LIROBJ('POINT',IPTGEN,1,IRET)
  1337. IF (IERR.NE.0) RETURN
  1338. C Transformer le point en maillage de POI1 (avec un seul element)
  1339. CALL CRELEM(IPTGEN)
  1340. C On verifie s'il n'a pas deja ete preconditionne.
  1341. CALL CRECH1(IPTGEN,1)
  1342. C
  1343. C 'PHAS' : nom de phase
  1344. ELSE IF (LECON.EQ.4) THEN
  1345. CALL LIRCHA(PHAM,1,IRET)
  1346. IF (IERR.NE.0) RETURN
  1347. C
  1348. C 'STAT' :
  1349. ELSE IF (LECON.EQ.5) THEN
  1350. NMAT = NMAT + 1
  1351. LESPRO(NMAT) = 'STATIONNAIRE'
  1352. IF (IPTABS.LE.0) THEN
  1353. CALL LIROBJ('MMODEL',IPMOD1,1,IRET)
  1354. IF (IERR.NE.0) RETURN
  1355. ENDIF
  1356. C
  1357. C 'LCOI'/'LCOS' : options non documentees pour le modele LIAISON !
  1358. C Lecture obligatoire du modele associe (sinon options sans interet)
  1359. ELSE IF (LECON.EQ.6.OR.LECON.EQ.7) THEN
  1360. IF (LESFOR(1).NE.'LIAISON') THEN
  1361. CALL ERREUR(251)
  1362. RETURN
  1363. ENDIF
  1364. CALL LIROBJ('MMODEL ',ipmod2,1,iret)
  1365. IF (IERR.NE.0) RETURN
  1366. CALL ACTOBJ('MMODEL ',ipmod2,1)
  1367. IF (IERR.NE.0) RETURN
  1368. mmode2 = ipmod2
  1369. n2 = mmode2.kmodel(/1)
  1370. if (n2.ne.1) then
  1371. write(ioimp,*) 'Liaison conditionnelle mal specifiee (1)'
  1372. call erreur(5)
  1373. return
  1374. endif
  1375. imode2 = mmode2.kmodel(1)
  1376. if (imode2.formod(1).ne.'LIAISON') THEN
  1377. write(ioimp,*) 'Liaison conditionnelle mal specifiee (2)'
  1378. call erreur(5)
  1379. return
  1380. endif
  1381. if (klcon.eq.0) then
  1382. nlcon = 10
  1383. segini plicon
  1384. endif
  1385. klcon = klcon + 1
  1386. if (klcon.gt.nlcon) then
  1387. nlcon = nlcon + 10
  1388. segadj plicon
  1389. endif
  1390. mlicon(klcon) = ipmod2
  1391. tlicon(klcon) = lecon
  1392. NOBMOD=klcon
  1393. C
  1394. C 'LIBRE' : option pour les elements JOI1
  1395. ELSE IF (LECON.EQ.8) THEN
  1396. ILIE = 0
  1397. C
  1398. C 'LIE' : option pour les elements JOI1
  1399. ELSE IF (LECON.EQ.9) THEN
  1400. ILIE = 1
  1401. C
  1402. C 'NON_LOCAL' : option pour les modelisations non locales
  1403. ELSE IF (LECON.EQ.10) THEN
  1404. IF (LESFOR(1).NE.'MECANIQUE'.AND.LESFOR(1).NE.'POREUX') THEN
  1405. CALL ERREUR(251)
  1406. RETURN
  1407. ENDIF
  1408. C
  1409. MN3 = 14
  1410. CALL MODNLO(MNLOCA,NLODIM)
  1411. CALL LIRMOT(MNLOCA,NLODIM,INLOC,1)
  1412. IF (IERR.NE.0) RETURN
  1413. CALL LIRMOT(MNLVAR,1,INLVIA,1)
  1414. IF (IERR.NE.0) RETURN
  1415. CALL LIROBJ('LISTMOTS',LULVIA,1,IRET)
  1416. IF (IERR.NE.0) RETURN
  1417. C
  1418. C 'LINE'/'CHPO'/'GAP7' : ???
  1419. ELSE IF (LECON.GE.11.and.LECON.LE.13) THEN
  1420. if (kbnlin.eq.0) then
  1421. jgn = 4
  1422. JGM = 3
  1423. segini opnlin
  1424. endif
  1425. kbnlin = kbnlin + 1
  1426. opnlin.mots(kbnlin) = mocon(lecon)
  1427. C
  1428. C 'COMP' :
  1429. ELSE IF (LECON.EQ.14) THEN
  1430. NMAT = NMAT + 1
  1431. LESPRO(NMAT) = 'COMPORTEMENT'
  1432. CALL LIROBJ('MMODEL',IPMOD3,1,IRET)
  1433. IF (IERR.NE.0) RETURN
  1434. C
  1435. C 'EPSI' : option desuete
  1436. ELSE IF (LECON.EQ.15) THEN
  1437. C CALL LIRMOT(MDERIV,6,IRET,1)
  1438. C IF(IERR.NE.0) RETURN
  1439. C JDERIV=IRET
  1440. cbp,2020-12-10 : abandon de MEPSIL (CCOPTIO) et IDERIV (MMODEL)
  1441. MOTERR(1:40)='MODE ... EPSI ... ;'
  1442. CALL ERREUR(1056)
  1443. RETURN
  1444. C
  1445. ENDIF
  1446. GOTO 675
  1447. 22 CONTINUE
  1448. C ==================================================================
  1449. C 5- Creation du modele MMODEL
  1450. C ==================================================================
  1451. IF (IPTABM.GT.0.AND.IPTABS.EQ.0.AND.IPMOD1.GT.0) GOTO 91
  1452. C
  1453. CALL ACTOBJ('MAILLAGE',IPGEOM,1)
  1454. MELEME = IPGEOM
  1455. NSOU = MELEME.LISOUS(/1)
  1456. NSOU1 = MAX(1,NSOU)
  1457.  
  1458. C=DEB==== FORMULATION HHO ==== Premieres verifications =================
  1459. IPLHHO = 0
  1460. IF (loHHO) THEN
  1461. C= Pour l'instant, HHO en formulation MECANIQUE !
  1462. IF ( (NFOR.EQ.1 .AND. LESFOR(1).NE.'MECANIQUE') .OR.
  1463. & (NFOR.NE.1) ) THEN
  1464. write(ioimp,*) 'Formulation HHO --> MECANIQUE uniquement'
  1465. CALL ERREUR(251)
  1466. RETURN
  1467. END IF
  1468. IF ( .NOT. ( IFOMOD.EQ.-1 .AND. IFOUR.NE.-3) ) THEN
  1469. write(ioimp,*) 'Formulation HHO --> 2D PLAN DEFO/CONT'
  1470. c-dbg IF ( .NOT. ( (IFOMOD.EQ.2) .OR.
  1471. c-dbg & (IFOMOD.EQ.-1 .AND. IFOUR.NE.-3) ) ) THEN
  1472. c-dbg write(ioimp,*) 'Formulation HHO --> 2D PLAN DEFO/CONT or 3D'
  1473. CALL ERREUR(251)
  1474. RETURN
  1475. END IF
  1476. C=
  1477. CALL HHOPRE(CHAHHO,IPGEOM,IPLHHO,iret)
  1478. IF (iret.NE.0) THEN
  1479. CALL ERREUR(iret)
  1480. RETURN
  1481. ENDIF
  1482. nobHHO = NOBMOD
  1483. NOBMOD = NOBMOD + MTYHHO
  1484. END IF
  1485. C=FIN==== FORMULATION HHO ==============================================
  1486.  
  1487. N1 = NSOU1
  1488. SEGINI,MMODEL,MMODE2
  1489. IPMODE = MMODEL
  1490. C
  1491. C Par defaut, le nom du constituant est le pointeur sur le MMODEL
  1492. IF (KCONS.EQ.0) WRITE(CONM,FMT='(I16)') IPMODE
  1493. C ==================================================================
  1494. C 6- Creation des modeles elementaires IMODEL
  1495. C ==================================================================
  1496. IPT1 = MELEME
  1497. DO 10 IM = 1, NSOU1
  1498.  
  1499. IF (NSOU.NE.0) IPT1 = MELEME.LISOUS(IM)
  1500. ITYP1 = IPT1.ITYPEL
  1501. NBNN = IPT1.NUM(/1)
  1502. NBEL = IPT1.NUM(/2)
  1503. C +--------------------------------------------------------------------+
  1504. C | Creation du modele elementaire IMODEL |
  1505. C +--------------------------------------------------------------------+
  1506. SEGINI,IMODEL
  1507. MMODEL.KMODEL(IM) = IMODEL
  1508. C +--------------------------------------------------------------------+
  1509. C | Remplissage du IMODEL |
  1510. C +--------------------------------------------------------------------+
  1511. IMODEL.IMAMOD = IPT1
  1512. IMODEL.CONMOD(1:16) = CONM
  1513. IMODEL.CONMOD(17:24) = PHAM
  1514. DO I = 1, NFOR
  1515. IMODEL.FORMOD(I) = LESFOR(I)
  1516. ENDDO
  1517. IF (NMAT.NE.0) THEN
  1518. DO I = 1, NMAT
  1519. IMODEL.MATMOD(I) = LESPRO(I)
  1520. ENDDO
  1521. ENDIF
  1522. C
  1523. C Informations liees au MATERIAU/COMPORTEMENT
  1524. CMATE = ' '
  1525. IMATE = 0
  1526. INATU = 0
  1527. CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU)
  1528. IF (IERR.NE.0) THEN
  1529. write(ioimp,*) ' Probleme apres NOMATE'
  1530. KERRE=251
  1531. GOTO 99
  1532. ENDIF
  1533. C Modele VISCO_EXTERNE : On recupere IVIEX stocke dans INATU
  1534. IF (LMEVIX) THEN
  1535. IVIEX = -2 - INATU
  1536. INATU = -2
  1537. ENDIF
  1538. IMODEL.CMATEE = CMATE
  1539. IMODEL.IMATEE = IMATE
  1540. IMODEL.INATUU = INATU
  1541. IMODEL.IDERIV = JDERIV
  1542. C +--------------------------------------------------------------------+
  1543. C | Remplissage des couples TYMODE/IVAMOD |
  1544. C +--------------------------------------------------------------------+
  1545. IF (LESFOR(1).EQ.'THERMIQUE ') THEN
  1546. IF (IRAYE.NE.0) THEN
  1547. IF (ICAVIT.NE.0) THEN
  1548. TYMODE(1)='ENTIER'
  1549. IVAMOD(1)=NBGA
  1550. TYMODE(2)='ENTIER'
  1551. IVAMOD(2)=NBDANG
  1552. IF (ISYME.EQ.1) THEN
  1553. TYMODE(3)='POINT'
  1554. TYMODE(4)='POINT'
  1555. IF(IDIM.EQ.3)TYMODE(5)='POINT'
  1556. IVAMOD(3)=IPP1
  1557. IVAMOD(4)=IPP2
  1558. IF(IDIM.EQ.3)IVAMOD(5)=IPP3
  1559. ENDIF
  1560. ELSE IF(IFACAF.NE.0) THEN
  1561. TYMODE(1)='MAILLAGE'
  1562. IVAMOD(1)= IPFAC1
  1563. TYMODE(2)='MAILLAGE'
  1564. IVAMOD(2)= IPFAC2
  1565. TYMODE(3)='MAILLAGE'
  1566. IVAMOD(3)= IPFAC3
  1567. TYMODE(4)='MMODEL'
  1568. IVAMOD(4)= IMOCO
  1569. ENDIF
  1570. ENDIF
  1571. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1572. ELSE IF (LESFOR(1).EQ.'MECANIQUE ') THEN
  1573. IF (LESPRO(2)(1:8).EQ.'MODAL '.AND.IPTBMO.GT.0) THEN
  1574. TYMODE(1) = 'TABLE'
  1575. IVAMOD(1) = IPTBMO
  1576. IF (IPMOD3.GT.0) THEN
  1577. NOBMOD = IVAMOD(/1)
  1578. TYMODE(NOBMOD) = 'MMODEL '
  1579. IVAMOD(NOBMOD) = IPMOD3
  1580. ENDIF
  1581. ELSE IF (JLMOT1.GT.0) THEN
  1582. IVAMOD(1) = JLMOT1
  1583. IVAMOD(2) = JLMOT2
  1584. TYMODE(1) = 'LISTMOTS'
  1585. TYMODE(2) = 'LISTMOTS'
  1586. LCVAR = JLMOT1
  1587. LCMAT = JLMOT2
  1588. ELSE IF (LMOEXT) THEN
  1589. IF (LMOLOI.GT.0) THEN
  1590. C
  1591. C Indicateur 'LMEEXT' pour retrouver ses petits
  1592. CALL POSCHA('LMEEXT ',I_POS)
  1593. TYMODE(1)='MOT '
  1594. IVAMOD(1)= I_POS
  1595. C
  1596. C Pointeur vers la loi (donne par PTRLOI)
  1597. TYMODE(2)='ENTIER '
  1598. IVAMOD(2)= LMOPTR
  1599. C
  1600. C LMOLIB : Nom de la bibliotheque (sans chemin et extension)
  1601. CALL POSCHA(LMOLIB(1:LMOLGB),I_POS)
  1602. TYMODE(3)='MOT '
  1603. IVAMOD(3)= I_POS
  1604. C
  1605. C LMOFCT : Nom de la fonction (dans la bibliotheque)
  1606. CALL POSCHA(LMOFCT(1:LMOLGT),I_POS)
  1607. TYMODE(4)='MOT '
  1608. IVAMOD(4)= I_POS
  1609. ENDIF
  1610.  
  1611. IF (LMEVIX) THEN
  1612. IMODEL.TYMODE(NOBMOD) = 'IVIEX '
  1613. IMODEL.IVAMOD(NOBMOD) = IVIEX
  1614. ENDIF
  1615. ENDIF
  1616. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1617. ELSE IF (LESFOR(1).EQ.'CONTACT ') THEN
  1618. TYMODE(1)='MAILLAGE'
  1619. IVAMOD(1)=IPGEO1
  1620. TYMODE(2)='MAILLAGE'
  1621. IVAMOD(2)=IPGEO2
  1622. TYMODE(3)='ENTIER'
  1623. IVAMOD(3)=ITCO
  1624. IF(ITCO.EQ.3) THEN
  1625. SEGINI,IMODE1
  1626. MMODE2.KMODEL(IM)=IMODE1
  1627. IMODE1.IMAMOD=IPGEOY
  1628. IMODE1.TYMODE(1)='MAILLAGE'
  1629. IMODE1.IVAMOD(1)=IPGEO2
  1630. IMODE1.TYMODE(2)='MAILLAGE'
  1631. IMODE1.IVAMOD(2)=IPGEO1
  1632. IMODE1.TYMODE(3)='ENTIER'
  1633. IMODE1.IVAMOD(3)=1
  1634. ENDIF
  1635. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1636. ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES ') THEN
  1637. IF (NOBMOD.GT.0) THEN
  1638. TYMODE(1) = 'LISTMOTS'
  1639. IVAMOD(1) = OPNLIN
  1640. ENDIF
  1641. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1642. ELSE IF (LESFOR(1).EQ.'LIAISON ') THEN
  1643. if (klcon.gt.0) THEN
  1644. do i = 1, klcon
  1645. if (tlicon(i).eq.6) TYMODE(noblia+i) = 'CONDINFE'
  1646. if (tlicon(i).eq.7) TYMODE(noblia+i) = 'CONDSUPE'
  1647. IVAMOD(noblia+i) = mlicon(i)
  1648. enddo
  1649. ENDIF
  1650. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1651. ELSE IF (LESFOR(1).EQ.'MELANGE ') THEN
  1652. IF (IPMMEL.GT.0) THEN
  1653. MMODE1 = IPMMEL
  1654. N1MEL = MMODE1.KMODEL(/1)
  1655. KBMOD = 0
  1656. DO I = 1,N1MEL
  1657. IMODE1 = MMODE1.KMODEL(I)
  1658. IF (IMODE1.IMAMOD.EQ.IMAMOD) THEN
  1659. IF (KBMOD.EQ.0) THEN
  1660. IMODE2 = IMODE1
  1661. ELSE
  1662. IF (IMODE1.FORMOD(1).NE.IMODE2.FORMOD(1).OR.
  1663. & IMODE1.IMATEE.NE.IMODE2.IMATEE) GOTO 117
  1664. ENDIF
  1665. KBMOD = KBMOD + 1
  1666. TYMODE(KBMOD) = 'IMODEL'
  1667. IVAMOD(KBMOD) = IMODE1
  1668. ENDIF
  1669. 117 CONTINUE
  1670. ENDDO
  1671. C
  1672. IF (KBMOD.EQ.0) THEN
  1673. CALL ERREUR(21)
  1674. RETURN
  1675. ENDIF
  1676. C
  1677. IF (KBMOD.NE.N1MEL) THEN
  1678. NOBMOD = KBMOD
  1679. SEGADJ,IMODEL
  1680. ENDIF
  1681. C
  1682. ENDIF
  1683. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1684. ELSE IF (LESFOR(1).EQ.'DIFFUSION ') THEN
  1685. JGN = LOCOMP
  1686. JGM = 2
  1687. SEGINI,MLMOT1
  1688. TYMODE(1)='LISTMOTS'
  1689. IVAMOD(1)=iplrdi
  1690. IF (LMOLOI.GT.0) THEN
  1691. C Indicateur 'LDIEXT' pour retrouver ses petits
  1692. CALL POSCHA('LDIEXT ',I_POS)
  1693. TYMODE(2)='MOT '
  1694. IVAMOD(2)= I_POS
  1695.  
  1696. C Pointeur vers la loi (donne par PTRLOI)
  1697. TYMODE(3)='ENTIER '
  1698. IVAMOD(3)= LMOPTR
  1699.  
  1700. C LMOLIB : Nom de la bibliotheque (sans chemin et extension)
  1701. CALL POSCHA(LMOLIB(1:LMOLGB),I_POS)
  1702. TYMODE(4)='MOT '
  1703. IVAMOD(4)= I_POS
  1704.  
  1705. C LMOFCT : Nom de la fonction (dans la bibliotheque)
  1706. CALL POSCHA(LMOFCT(1:LMOLGT),I_POS)
  1707. TYMODE(5)='MOT '
  1708. IVAMOD(5)= I_POS
  1709. ENDIF
  1710. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1711. ELSE IF (LESFOR(1).EQ.'METALLURGIE ') THEN
  1712. C LCVAR : les noms des phases
  1713. IVAMOD(1) = LCVAR
  1714. TYMODE(1) = 'LISTMOTS'
  1715. C IREACT : les noms des reactifs
  1716. IVAMOD(2) = ireact
  1717. TYMODE(2) = 'LISTMOTS'
  1718. C IPRODU : les noms des produits
  1719. IVAMOD(3) = iprodu
  1720. TYMODE(3) = 'LISTMOTS'
  1721. C LCMAT : les noms des types de reactions
  1722. IVAMOD(4) = LCMAT
  1723. TYMODE(4) = 'LISTMOTS'
  1724. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1725. ELSE IF (LESFOR(1).EQ.'CHANGEMENT_PHASE') THEN
  1726. C
  1727. C Maillage support de mult. de Lagrange IPGEO2 & IPGEO3
  1728. CALL IMPP1(IPT1,IPGEO2,IPGEO3,LESPRO(1))
  1729. C
  1730. C IPRIDU : les noms des variables primales et duales
  1731. IVAMOD(1) = IPRIDU
  1732. TYMODE(1) ='LISTMOTS'
  1733. IVAMOD(2) = IPGEO2
  1734. TYMODE(2) ='MAILLAGE'
  1735. IF (LESPRO(1).EQ.'SOLUBILITE ') THEN
  1736. IVAMOD(3) = IPGEO3
  1737. TYMODE(3) ='MAILLAGE'
  1738. ENDIF
  1739. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1740. ELSE IF (LESFOR(1).EQ.'CONTRAINTE ') THEN
  1741. TYMODE(1)='ENTIER'
  1742. IVAMOD(1)=LACTR
  1743. TYMODE(2)='MAILLAGE'
  1744. IVAMOD(2)=IPGEOC
  1745. IF (LACTR.EQ.1) THEN
  1746. TYMODE(3)='POINT'
  1747. IVAMOD(3)=IP1
  1748. IF (IDIM.EQ.3) THEN
  1749. TYMODE(4)='POINT'
  1750. IVAMOD(4)=IP2
  1751. ENDIF
  1752. ELSE IF (LACTR.EQ.2) THEN
  1753. TYMODE(3)='POINT'
  1754. IVAMOD(3)=IP1
  1755. ENDIF
  1756. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1757. ENDIF
  1758.  
  1759. C=DEB==== FORMULATION HHO ==== Remplissage de donnees ==================
  1760. C NEFMOD = HHO_NUM_ELEMENT pour tous les elements =====
  1761. IF (loHHO) THEN
  1762. modHHO = imodel
  1763. CALL HHOPRM(chaHHO,modHHO,nobHHO,iplHHO,KERRE)
  1764. IF (KERRE.NE.0) GOTO 99
  1765. imodel.NEFMOD = HHO_NUM_ELEMENT
  1766. GOTO 101
  1767. ENDIF
  1768. C=FIN==== FORMULATION HHO ==============================================
  1769. C +--------------------------------------------------------------------+
  1770. C | Determination de la valeur de NEFMOD pour IMODEL |
  1771. C +--------------------------------------------------------------------+
  1772. IF (ITYP1.EQ.48) THEN
  1773. C NEPAPA = si EF specifique demande -> on utilise ses inconnues
  1774. NEPAPA = 0
  1775. IMODEL.NEFMOD = 259
  1776. IF (ITEF.GT.0) THEN
  1777. DO i=1,ITEF
  1778. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1779. IF (MELE.NE.0) NEPAPA = MELE
  1780. ENDDO
  1781. ENDIF
  1782. IF (NEPAPA.EQ.0) THEN
  1783. c 2D : on choisit les inconnues du QUA4 pour toute formulation
  1784. IF (IDIM.EQ.2) THEN
  1785. NEPAPA=8
  1786. c 3D : on choisit les inconnues du CUB8 pour toute formulation
  1787. ELSE IF (IDIM.EQ.3) THEN
  1788. NEPAPA=14
  1789. ELSE
  1790. CALL ERREUR(610)
  1791. RETURN
  1792. ENDIF
  1793. ENDIF
  1794. GOTO 101
  1795. ENDIF
  1796. C
  1797. NEFMOD = 0
  1798. IF (ITEF.NE.0) THEN
  1799. DO i=1,ITEF
  1800. IF (LONAVI) THEN
  1801. CALL MODE25(MDISC,ITYP1,MELE)
  1802. ELSE
  1803. IF (LOBBAR) CALL MODE20(ITYP1,LESTEF(I))
  1804. CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i))
  1805. ENDIF
  1806. IF (MELE.EQ.0) GOTO 9
  1807. IF (LONAVI) GOTO 6
  1808. MEGE=NUMGEO(MELE)
  1809. IF (MEGE.EQ.0) GOTO 9
  1810. IF (MEGE.EQ.ITYP1) GOTO 6
  1811. c kich cas du POI1
  1812. IF (ITYP1.EQ.1) GOTO 6
  1813. ENDDO
  1814. C
  1815. 9 CONTINUE
  1816. KERRE=16
  1817. GOTO 99
  1818. C
  1819. 6 CONTINUE
  1820. NEFMOD=MELE
  1821. C Cas particulier pour les elements polygonaux
  1822. IF (ITYP1.EQ.32) NEFMOD=MELE+NBNN-3
  1823. C Affectation des elements finis de maniere automatique
  1824. ELSE
  1825. C Formulation DARCY
  1826. IF (LESFOR(1).EQ.'DARCY') THEN
  1827. IF (ITYP1.EQ. 3) NEFMOD=143
  1828. C IF (ITYP1.EQ. 4) NEFMOD=99
  1829. C IF (ITYP1.EQ. 8) NEFMOD=100
  1830. C IF (ITYP1.EQ.23) NEFMOD=101
  1831. C IF (ITYP1.EQ.16) NEFMOD=102
  1832. C IF (ITYP1.EQ.14) NEFMOD=103
  1833. IF (ITYP1.EQ. 7) NEFMOD=99
  1834. IF (ITYP1.EQ.11) NEFMOD=100
  1835. IF (ITYP1.EQ.35) NEFMOD=101
  1836. IF (ITYP1.EQ.34) NEFMOD=102
  1837. IF (ITYP1.EQ.33) NEFMOD=103
  1838. C Formulation CONTACT
  1839. ELSE IF (LESFOR(1).EQ.'CONTACT') THEN
  1840. NEFMOD=ITYP1
  1841. IF (ITCO.EQ.0) THEN
  1842. IF (IDIM.EQ.2) NEFMOD=261
  1843. IF (IDIM.EQ.3) NEFMOD=262
  1844. ELSE IF (IFRT.EQ.1) THEN
  1845. IF (IDIM.EQ.2) NEFMOD=107
  1846. IF (IDIM.EQ.3) NEFMOD=165
  1847. ENDIF
  1848. C Formulation POREUX
  1849. ELSE IF (LESFOR(1).EQ.'POREUX') THEN
  1850. IF (ITYP1.EQ. 6) NEFMOD=79
  1851. IF (ITYP1.EQ.10) NEFMOD=80
  1852. IF (ITYP1.EQ.15) NEFMOD=81
  1853. IF (ITYP1.EQ.24) NEFMOD=82
  1854. IF (ITYP1.EQ.17) NEFMOD=83
  1855. IF (ITYP1.EQ.29) NEFMOD=108
  1856. IF (ITYP1.EQ.30) NEFMOD=109
  1857. IF (ITYP1.EQ.31) NEFMOD=110
  1858. C Autres formulations
  1859. ELSE
  1860. CALL PLACE(MOTEF,NBTEF,NELE,NOMS(ITYP1))
  1861. IF (NELE.EQ.0) GOTO 8
  1862. CALL PLACE(NOMTP,LNOMTP,MELE,MOTEF(NELE))
  1863. IF (MELE.NE.0) GOTO 7
  1864. C
  1865. 8 CONTINUE
  1866. C Cas particulier dimension 1 : [M-T]1D[2-3]
  1867. IF (IDIM.EQ.1) THEN
  1868. DO IE=1,NBTEF
  1869. CALL PLACE(NOMTP,LNOMTP,MELE,MOTEF(IE))
  1870. MEGE=NUMGEO(MELE)
  1871. IF (MEGE.EQ.ITYP1) GOTO 7
  1872. ENDDO
  1873. ENDIF
  1874. C
  1875. KERRE=16
  1876. GOTO 99
  1877. C
  1878. 7 CONTINUE
  1879. NEFMOD=MELE
  1880. ENDIF
  1881. ENDIF
  1882. C
  1883. IF (NEFMOD.EQ.0) THEN
  1884. KERRE=16
  1885. GOTO 99
  1886. ENDIF
  1887. C +--------------------------------------------------------------------+
  1888. C | Verifications supplementaires entre type d'EF et formulation |
  1889. C +--------------------------------------------------------------------+
  1890. 101 CONTINUE
  1891. MFR = NUMMFR(NEFMOD)
  1892. C WRITE(6,*)' ITYP1 =',ITYP1,NEFMOD,MFR
  1893. C
  1894. IF (LESFOR(1).EQ.'THERMIQUE ') THEN
  1895. IF (IPHAS.NE.0) THEN
  1896. c test que les elements sont lineaires
  1897. IPT4 = IMODEL.IMAMOD
  1898. ITT = IPT4.ITYPEL
  1899. IF (KDEGRE(ITT) .GT. 2) THEN
  1900. KERRE=982
  1901. GOTO 99
  1902. ENDIF
  1903. ENDIF
  1904.  
  1905. ELSE IF ((LESFOR(1).EQ.'MECANIQUE ') .OR.
  1906. & (LESFOR(1).EQ.'POREUX ')) THEN
  1907. C
  1908. C Elements polygonaux
  1909. IF ((ITYP1.EQ.32).AND.(NBNN.GT.14)) THEN
  1910. INTERR(1) = 32
  1911. KERRE=52
  1912. GOTO 99
  1913. ENDIF
  1914. C
  1915. C Cas du materiau unidirectionnel
  1916. IF (IMATE.EQ.4) THEN
  1917. C Cas des cerces : sans interet !
  1918. IF (MFR.EQ.27) THEN
  1919. KERRE=251
  1920. GOTO 99
  1921. ENDIF
  1922. C Cas de la plasticite
  1923. IF (INATU.NE.0) THEN
  1924. C
  1925. C Comportement ACIER_UNI OK si massif bidim ou coque tridim
  1926. IF (INATU.EQ.40)THEN
  1927. IF ((MFR.NE.1.OR.IFOUR.GT.0).AND.
  1928. & ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN
  1929. KERRE=251
  1930. GOTO 99
  1931. ENDIF
  1932. C Autres comportements OK si COQ2 et massif
  1933. ELSE IF (NEFMOD.NE.44.AND.MFR.NE.1) THEN
  1934. KERRE=251
  1935. GOTO 99
  1936. ENDIF
  1937. ENDIF
  1938. ENDIF
  1939. C
  1940. C Cas du materiau 'ZONE_COHESIVE'
  1941. IF ((IMATE.EQ.12).AND.(MFR.NE.77)) THEN
  1942. KERRE=251
  1943. GOTO 99
  1944. ENDIF
  1945. C
  1946. C Cas du modele section : on n'autorise pour le moment que TIMO
  1947. IF (CMATE.EQ.'SECTION'.AND.NEFMOD.NE.84) THEN
  1948. KERRE=251
  1949. GOTO 99
  1950. ENDIF
  1951. C
  1952. C Comportement GURSON OK en 3D, axisymetrique ou deformations planes
  1953. IF (INATU.EQ.38) THEN
  1954. IF ( IFOUR.NE.0 .AND. IFOUR.NE.2 .AND. IFOUR.NE.-1 ) THEN
  1955. MOTERR(1:8)='GURSON'
  1956. MOTERR(9:16)='MECANIQU'
  1957. INTERR(1) = IFOUR
  1958. KERRE=81
  1959. GOTO 99
  1960. ENDIF
  1961. ENDIF
  1962. C
  1963. C Comportement ISS_GRANGE OK qu'en 3D
  1964. IF (INATU.EQ.151 .AND. IFOUR.NE.2) THEN
  1965. INTERR(1) = IFOUR
  1966. KERRE=709
  1967. GOTO 99
  1968. ENDIF
  1969. C
  1970. C Le modele RUP_THER n'est utilisable qu'en 3D
  1971. IF (INATU.EQ.152 .AND. IFOUR.NE.2) THEN
  1972. INTERR(1) = IFOUR
  1973. KERRE=709
  1974. GOTO 99
  1975. ENDIF
  1976. C
  1977. C Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1
  1978. IF (INATU.EQ.34 .AND. IFOUR.NE.2 .AND. MFR.EQ.75) THEN
  1979. INTERR(1) = IFOUR
  1980. KERRE=709
  1981. GOTO 99
  1982. ENDIF
  1983. C
  1984. C.. Restrictions en formulation 'MECANIQUE' avec une loi de
  1985. C comportement non lineaire externe
  1986. C Rappel : LMOEXT exprime la condition (NFOR.EQ.1) ET
  1987. C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe)
  1988. IF ( LMOEXT ) THEN
  1989. C En formulation 'MECANIQUE', les lois non lineaires externes
  1990. C n'autorisent qu'une seule composante de temperature
  1991. C => incompatibilite avec des modeles de coques n'ayant pas
  1992. C de points d'integration dans l'epaisseur (trois composantes
  1993. C dans ce cas, 'TINF', 'T ' et 'TSUP')
  1994. C Le test ci-dessous est coherent avec celui de IDTEMP.
  1995. IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND.
  1996. & (NGINT.EQ.0) ) THEN
  1997. KERRE=951
  1998. GOTO 99
  1999. ENDIF
  2000. C Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour
  2001. C l'instant qu'aux elements massifs, avec option de calcul 3D
  2002. C Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL'
  2003. IF ( LMEVIX ) THEN
  2004. IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN
  2005. KERRE = 950
  2006. ELSE IF ( IVIEX.NE.1 ) THEN
  2007. KERRE = 958
  2008. ELSE
  2009. KERRE = 0
  2010. ENDIF
  2011. IF (KERRE.NE.0) GOTO 99
  2012. ENDIF
  2013. ENDIF
  2014. C
  2015. ELSE IF (LESFOR(1).EQ.'DIFFUSION ') THEN
  2016. IF (IFOUR.EQ.2 .AND. NEFMOD.GE.4 .AND. NEFMOD.LT.11) THEN
  2017. KERRE=16
  2018. GOTO 99
  2019. ENDIF
  2020. IF (MFR.NE.1 .AND. MFR.NE.3 .AND. MFR.NE.5 .AND.
  2021. & MFR.NE.7 .AND. MFR.NE.9 .AND. MFR.NE.73 .AND.
  2022. & MFR.NE.27 .AND. MFR.NE.75 .AND. MFR.NE.79 ) THEN
  2023. KERRE=16
  2024. GOTO 99
  2025. ENDIF
  2026. C
  2027. ENDIF
  2028. C +--------------------------------------------------------------------+
  2029. C | Remplissage INFMOD et INFELE du IM-eme modele elementaire IMODEL |
  2030. C +--------------------------------------------------------------------+
  2031. IF (NGINT.NE.0.AND.NEFMOD.NE.28) THEN
  2032. KERRE=608
  2033. GOTO 99
  2034. ENDIF
  2035. INFMOD(1) = NGINT
  2036.  
  2037. C (fdp) Pour les elements JOI1 seulement, on stocke -1*ILIE dans INFMOD(9)
  2038. IF (ILIE.NE.0) THEN
  2039. IF (NEFMOD.NE.265) THEN
  2040. KERRE=19
  2041. GOTO 99
  2042. ENDIF
  2043. INFMOD(9) = -1 * ILIE
  2044. ENDIF
  2045. * AM cas non-local
  2046. IF (INLOC.NE.0) THEN
  2047. INFMOD(13) = -1*INLOC
  2048. INFMOD(14) = LULVIA
  2049. ENDIF
  2050.  
  2051. C Initialisation du infele et des segments d'integration
  2052. INFELE(2) = NGINT
  2053. INFELE(3) = NGMAS
  2054. INFELE(4) = NGCON
  2055. INFELE(6) = NGRIG
  2056.  
  2057. C Cas particulier des relations de conformite pour les SURE
  2058. IF (ITYP1.EQ.48) THEN
  2059. IMODEL.INFELE( 1) = NEFMOD
  2060. IMODEL.INFELE(13) = NUMMFR(NEPAPA)
  2061. IMODEL.INFELE(14) = 48
  2062. ENDIF
  2063. C
  2064. CALL PRQUOI(IMODEL)
  2065. IF (IERR.NE.0) RETURN
  2066. C +--------------------------------------------------------------------+
  2067. C | Initialisation des nomid (NOMS des composantes) |
  2068. C +--------------------------------------------------------------------+
  2069. C Cas particulier des relations de conformite pour les SURE
  2070. c on recupere les noms de composantes 'DEPLACEM' et 'FORCES'
  2071. c des elements parents (NEPAPA => QUA4 ou CUB8)
  2072. IF (ITYP1.EQ.48) THEN
  2073. NEPOLD=IMODEL.NEFMOD
  2074. IMODEL.NEFMOD=NEPAPA
  2075. ENDIF
  2076. CALL INOMID(IMODEL,LCVAR,LCMAT,LCMAF,LCPAR)
  2077. IF (IERR.NE.0) RETURN
  2078. IF (ITYP1.EQ.48) THEN
  2079. IMODEL.NEFMOD=NEPOLD
  2080. ENDIF
  2081.  
  2082. C Test CLEMENT entre INFELE(16) et la dimension du NOMID des DEFORMATIONS
  2083. C ATTENTION (celui des CONTRAINTES peut contenir une info en plus sur les MODES en fourier...)
  2084. nomid = imodel.LNOMID(5)
  2085. IF (nomid.GT.0) THEN
  2086. imodel.INFELE(16) = nomid.LESOBL(/2) + nomid.LESFAC(/2)
  2087. ELSE
  2088. imodel.INFELE(16) = 0
  2089. ENDIF
  2090. C +--------------------------------------------------------------------+
  2091. C | Quelques verifications supplementaires |
  2092. C +--------------------------------------------------------------------+
  2093.  
  2094. C=DEB==== FORMULATION HHO ==== Verification des noms primales/duales====
  2095. IF (loHHO) THEN
  2096. nomid1 = imodel.LNOMID(1)
  2097. nomid2 = imodel.LNOMID(2)
  2098. c* SEGACT,nomid1,nomid2
  2099. n_z1 = nomid1.LESOBL(/2)
  2100. n_z2 = nomid2.LESOBL(/2)
  2101. IF (n_z1.EQ.0 .OR. n_z1.NE.n_z2) THEN
  2102. write(ioimp,*) 'MODELI HHO: PRIMAL/DUAL number incorrect'
  2103. CALL ERREUR(5)
  2104. RETURN
  2105. END IF
  2106. DO i = 1, n_z1
  2107. CALL VERMDI(nomid1.LESOBL(i),nomid2.LESOBL(i))
  2108. IF (IERR.NE.0) RETURN
  2109. END DO
  2110. n_z1 = nomid1.LESFAC(/2)
  2111. n_z2 = nomid2.LESFAC(/2)
  2112. IF (n_z1.NE.0 .OR. n_z2.NE.0) THEN
  2113. write(ioimp,*) 'MODELI HHO: LESFAC incorrect'
  2114. CALL ERREUR(5)
  2115. RETURN
  2116. END IF
  2117. END IF
  2118. C=FIN==== FORMULATION HHO ==============================================
  2119.  
  2120. mfr2 = INFELE(13)
  2121. IF (FORMOD(1).EQ.'CONTRAINTE') mfr2 = 0
  2122. IPMO = IMODEL
  2123. CALL COTEMO(IPMO,MFR2)
  2124. IF (IERR.NE.0) RETURN
  2125. C +--------------------------------------------------------------------+
  2126. C | Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14) |
  2127. C | Ce point n'est pris en compte que si cela est necessaire |
  2128. C +--------------------------------------------------------------------+
  2129. CALL INFDPG(mfr2,IFOUR,LOGRE,ndpge)
  2130. IF (LOGRE) THEN
  2131. C Erreur si ce point support n'est pas fourni avec le mot-cle GENE.
  2132. IF (IPTGEN.EQ.0) THEN
  2133. CALL ERREUR(925)
  2134. RETURN
  2135. ENDIF
  2136. imodel.IPDPGE = IPTGEN
  2137. ELSE
  2138. IF (IPTGEN.NE.0) THEN
  2139. write(ioimp,*) 'Mot-cle GENE + Point ignores...'
  2140. ENDIF
  2141. IMODEL.IPDPGE = 0
  2142. ENDIF
  2143.  
  2144. SEGACT,IMODEL*NOMOD
  2145.  
  2146. 10 CONTINUE
  2147. C ****************************************************************
  2148. C Fin de la boucle (10) sur les maillages elementaires de IPGEOM
  2149. C ****************************************************************
  2150. C Contact symetrique : tout mettre dans un meme modele
  2151. n1o = kmodel(/1)
  2152. n1 = n1o
  2153. do i = 1, n1o
  2154. imode1 = mmode2.kmodel(i)
  2155. if (imode1.ne.0) then
  2156. n1 = n1+1
  2157. endif
  2158. enddo
  2159. * On a trouve du contact :
  2160. if (n1.gt.n1o) then
  2161. segadj mmodel
  2162. nsou1 = n1
  2163. do i = 1, n1o
  2164. imode1 = mmode2.kmodel(i)
  2165. if (imode1.ne.0) then
  2166. kmodel(n1)=imode1
  2167. n1=n1-1
  2168. imodel=kmodel(i)
  2169. imode1.nefmod=nefmod
  2170. imode1.conmod=conmod
  2171. do ip=1,infmod(/1)
  2172. imode1.infmod(ip)=infmod(ip)
  2173. enddo
  2174. do ip=1,formod(/2)
  2175. imode1.formod(ip)=formod(ip)
  2176. enddo
  2177. do ip=1,matmod(/2)
  2178. imode1.matmod(ip)=matmod(ip)
  2179. enddo
  2180. imode1.ipdpge=ipdpge
  2181. imode1.cmatee=cmatee
  2182. imode1.imatee=imatee
  2183. imode1.inatuu=inatuu
  2184. imode1.ideriv=ideriv
  2185. do ip=1,lnomid(/1)
  2186. imode1.lnomid(ip)=lnomid(ip)
  2187. enddo
  2188. do ip=1,infele(/1)
  2189. imode1.infele(ip)=infele(ip)
  2190. enddo
  2191. do ip=1,tymode(/2)
  2192. imode1.tymode(ip)=tymode(ip)
  2193. enddo
  2194. endif
  2195. enddo
  2196. n1 = nsou1
  2197. endif
  2198. segsup mmode2
  2199.  
  2200. IPMODE=MMODEL
  2201.  
  2202. C TABLE DE MODES --------------------------------
  2203. IF (IPTBDM.GT.0) THEN
  2204. MMODEL = IPMODE
  2205. imodel = kmodel(1)
  2206. segact imodel*mod
  2207. call dimen7(iptbdm,idimen)
  2208. NBNN = 1
  2209. NBELEM = idimen - 2
  2210. NBSOUS = 0
  2211. NBREF = 0
  2212. SEGINI IPT8
  2213. IPT8.ITYPEL = 1
  2214.  
  2215. IKM = 0
  2216. DO ik = 1,NBELEM
  2217. IKM = IKM + 1
  2218. IVALIN=IKM
  2219. XVALIN=REAL(0.D0)
  2220. LOGIN=.TRUE.
  2221. IOBIN=0
  2222. TAPIND='ENTIER '
  2223. CHARIN=' '
  2224. TYPOBJ='TABLE'
  2225. CALL ACCTAB(IPTBDM,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN,
  2226. & TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  2227. IF (IERR.NE.0) RETURN
  2228. IPTMOD = IOBRE
  2229. IVALIN=0
  2230. XVALIN=REAL(0.D0)
  2231. LOGIN=.TRUE.
  2232. IOBIN=0
  2233. TAPIND='MOT '
  2234. TYPOBJ='POINT'
  2235. CALL ACCTAB(IPTMOD,TAPIND,IVALIN,XVALIN,'POINT_REPERE',LOGIN,
  2236. & IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  2237. IF (IERR.NE.0) RETURN
  2238.  
  2239. ipt8.num(1,ikm) = iobre
  2240. ENDDO
  2241.  
  2242. NBELEM = IKM
  2243. segadj IPT8
  2244. imamod = ipt8
  2245.  
  2246. ENDIF
  2247. C fin TABLE DE MODES --------------------------------
  2248. C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd
  2249. 91 CONTINUE
  2250. IF (IPTABS.GT.0.OR.IPMOD1.GT.0) THEN
  2251. c verification formulation
  2252. IF (ipmod1.gt.0) THEN
  2253. CALL ACTOBJ('MMODEL',IPMOD1,1)
  2254. IF (IERR.NE.0) RETURN
  2255. mmode1 = ipmod1
  2256. imode1 = mmode1.kmodel(1)
  2257. do jj=1,NFOR
  2258. if (imode1.formod(jj).ne.LESFOR(JJ)) then
  2259. call erreur(21)
  2260. return
  2261. endif
  2262. enddo
  2263. ENDIF
  2264. c duplique le modele cree
  2265. if (ipmod1.le.0) ipmod1 = ipmode
  2266. C modele : pointer le modele elementaire approprie
  2267. IF (iptabm.eq.0) THEN
  2268. MMODE1 = ipmod1
  2269. DO im = 1,kmodel(/1)
  2270. imodel = kmodel(im)
  2271. segact imodel*mod
  2272. nobmod = ivamod(/1)
  2273. nobmod = nobmod + 1
  2274. nfor = formod(/2)
  2275. nmat = matmod(/2)
  2276. mn3 = infmod(/1)
  2277. segadj imodel
  2278. kbmod = 0
  2279. do im1 = 1,MMODE1.KMODEL(/1)
  2280. imode1 = mmode1.kmodel(im1)
  2281. imomo = imode1
  2282. lostat = .true.
  2283.  
  2284. C criteres de verif assez sommaires ...
  2285. if (imode1.nefmod.eq.nefmod.and.
  2286. & imode1.imamod.ne.imamod.and.
  2287. & (imode1.matmod(/2).eq.matmod(/2).or.
  2288. & imode1.matmod(/2).eq.(matmod(/2)-1)).and.
  2289. & imode1.formod(/2).eq.formod(/2)) then
  2290. do lmo = 1,formod(/2)
  2291. if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false.
  2292. enddo
  2293. do lmo = 1,imode1.matmod(/2)
  2294. if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false.
  2295. enddo
  2296. else
  2297. lostat = .false.
  2298. endif
  2299. if (lostat.and.formod(1).eq.'MELANGE') then
  2300. C verifs supplementaires : les modeles de ivamod sont ils bien construi
  2301. lomela = .true.
  2302. if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false.
  2303. if (imode1.ivamod(/1).gt.0) then
  2304. do ivm3 = 1,imode1.ivamod(/1)
  2305. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2306. imode3 = imode1.ivamod(ivm3)
  2307. segact imode3
  2308. ENDIF
  2309. enddo
  2310. endif
  2311. IF (nobmod.gt.1) THEN
  2312. do ivm1 = 1,(nobmod-1)
  2313. if (tymode(ivm1).eq.'IMODEL ') then
  2314. imode2 = ivamod(ivm1)
  2315. segact imode2
  2316. if (imode2.ivamod(/1).ge.1) then
  2317. do ivm2 = 1,imode2.ivamod(/1)
  2318. if (imode2.tymode(ivm2).eq.'IMODEL') then
  2319. imode4 = imode2.ivamod(ivm2)
  2320. segact imode4
  2321. if (imode1.ivamod(/1).ge.1) then
  2322. do ivm3 = 1,imode1.ivamod(/1)
  2323. IF (imode1.tymode(ivm3).eq.'IMODEL') THEN
  2324. imode3 = imode1.ivamod(ivm3)
  2325. lostat = .true.
  2326. C criteres de verif assez faibles ...
  2327. if (imode3.nefmod.eq.imode4.nefmod.and.
  2328. & imode3.imamod.eq.imode4.imamod.and.
  2329. & imode3.matmod(/2).eq.imode4.matmod(/2).and.
  2330. & imode3.conmod(17:24).eq.imode4.conmod(17:24).and.
  2331. & imode3.formod(/2).eq.imode4.formod(/2)) then
  2332. do lmo = 1,imode4.formod(/2)
  2333. if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false.
  2334. enddo
  2335. do lmo = 1,imode4.matmod(/2)
  2336. if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false.
  2337. enddo
  2338. else
  2339. lostat = .false.
  2340. endif
  2341. if (lostat) goto 75
  2342. ENDIF
  2343. enddo
  2344. else
  2345. lostat = .false.
  2346. endif
  2347. endif
  2348. enddo
  2349. else
  2350. lomela = .false.
  2351. endif
  2352. 75 lomela = lomela.and.lostat
  2353. endif
  2354. enddo
  2355. ENDIF
  2356. lostat = lomela
  2357. do ivm3 = 1,imode1.ivamod(/1)
  2358. c imode1 = imomo
  2359. IF(imode1.tymode(ivm3).eq.'IMODEL') THEN
  2360. imode3 = imode1.ivamod(ivm3)
  2361. ENDIF
  2362. enddo
  2363. endif
  2364. if (lostat) then
  2365. kbmod = kbmod + 1
  2366. tymode(nobmod) = 'IMODEL'
  2367. ivamod(nobmod) = imomo
  2368. goto 79
  2369. endif
  2370. enddo
  2371. C *** ca se passe mal
  2372. if (kbmod.ne.1) then
  2373. write(ioimp,*) ' STATIO EN DEFAUT voir notice ',kbmod,im
  2374. KERRE=251
  2375. GOTO 99
  2376. endif
  2377. C ***
  2378. 79 CONTINUE
  2379. ENDDO
  2380. ENDIF
  2381.  
  2382. C : table : dupliquer modele elementaire et pointer
  2383. if (iptabm.gt.0) then
  2384. call modsta(ipmode,iptabm,ipmod1)
  2385. endif
  2386.  
  2387. ENDIF
  2388. C fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd
  2389.  
  2390. if (plicon.ne.0) segsup,plicon
  2391.  
  2392. C Ecriture de l'objet MODELE cree
  2393. CALL ACTOBJ('MMODEL ',IPMODE,1)
  2394. CALL ECROBJ('MMODEL ',IPMODE)
  2395. RETURN
  2396. C ==================================================================
  2397. C 7- Traitement des erreurs
  2398. C ==================================================================
  2399. 99 CONTINUE
  2400. CALL ERREUR(KERRE)
  2401. C
  2402. DO im = 1, kmodel(/1)
  2403. imodel = kmodel(im)
  2404. IF (imodel.NE.0) SEGSUP,imodel
  2405. ENDDO
  2406. SEGSUP,MMODEL
  2407. if (plicon.ne.0) segsup,plicon
  2408.  
  2409. END
  2410.  
  2411.  
  2412.  

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