Télécharger varinu.eso

Retour à la liste

Numérotation des lignes :

  1. C VARINU SOURCE CB215821 19/10/08 21:15:18 10329
  2.  
  3. SUBROUTINE VARINU(IPOI1,IPOI2,IPMODL,IRET,MICHE,JEMIL,CHARP)
  4.  
  5. *____________________________________________________________________
  6. *
  7. * OBJET : Variation d'un champ/élément ayant une ou des composante(s)
  8. * °°°°°°° de type EVOLUTION ou NUAGE (FLOTTANT-EVOLUTION
  9. * ou FLOTTANT-FLOTTANT-EVOLUTION) en fonction
  10. * d'un champ/point ou d'un champ/élément.Ce champ peut
  11. * avoir plusieurs composantes si necessaire. Dans ce cas il
  12. * est possible d'instancier un champ/element dont les
  13. * composantes dependent de parametres differents en
  14. * chaque point.
  15. *
  16. * ENTREES :
  17. * °°°°°°°°°
  18. *
  19. * IPOI1 Pointeur sur un MCHAML
  20. * IPOI2 Pointeur sur un CHPOINT ou MCHAML
  21. * IPMODL Pointeur sur un MMODEL
  22. * JEMIL 1 A 5 selon le support choisi
  23. * MICHE = 1 IPOI2 est un objet de type CHPOINT
  24. * = 0 IPOI2 est un objet de type MCHAML
  25. * CHARP Chaine definissant le sous type (facultatif)
  26. *
  27. *
  28. * SORTIE :
  29. * °°°°°°°°
  30. *
  31. * IRET Pointeur sur le MCHAML resultat
  32. * =0 si operation impossible
  33. *
  34. *_____________________________________________________________________
  35. *
  36. IMPLICIT INTEGER(I-N)
  37. IMPLICIT REAL*8(A-H,O-Z)
  38. *
  39. -INC SMCHAML
  40. -INC SMCHPOI
  41. -INC SMMODEL
  42. -INC CCOPTIO
  43. -INC SMEVOLL
  44. -INC SMLREEL
  45. -INC SMLENTI
  46. -INC SMELEME
  47. -INC SMINTE
  48. -INC SMCOORD
  49. -INC SMNUAGE
  50. -INC DECHE
  51. -INC SMLMOTS
  52. -INC SMTABLE
  53. -INC CCNOYAU
  54. -INC CCASSIS
  55.  
  56. EXTERNAL long
  57. *
  58. CHARACTER*(*) CHARP
  59. CHARACTER*16 CHA1,TYPV,CMNAME
  60. CHARACTER*72 SOUTYP
  61. CHARACTER*73 LMEFCT
  62. CHARACTER*512 MOTEMP,LMELIB,lacomm
  63. CHARACTER*8 TYP3,NOMTMP,MOT1,MOT2
  64. CHARACTER*8 NOMCO,NOM2,NOM3,NOM4,NOM5,NOMTT
  65. CHARACTER*4 NOMCO4,NOMSIM
  66. LOGICAL COQ,KNUAG,KREAL,KFLOT,lsupma,dstati,drev21,drev22
  67. LOGICAL BTHRD,dnua1
  68. INTEGER IPTAMO
  69. C
  70. C Creation des segments
  71. SEGMENT SWORK
  72. REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBN1)
  73. REAL*8 SHP(6,NBN1) ,XE(3,NBN1)
  74. ENDSEGMENT
  75. SEGMENT IAMOI
  76. REAL*8 VEL1(MG1,N1EL2),VEL2(MG2,MXNBE)
  77. ENDSEGMENT
  78. SEGMENT IAMO2
  79. REAL*8 FLO1(NFLO),FLO2(NFLO,NFLO)
  80. INTEGER IFLO2(NFLO)
  81. ENDSEGMENT
  82. SEGMENT WRKEXT
  83. CHARACTER*4 NOMPAR(NPARA)
  84. INTEGER IVAPAR(NPARA)
  85. REAL*8 VALPAR(NPARA)
  86. ENDSEGMENT
  87. SEGMENT WRKRES
  88. CHARACTER*4 NOMVAL(N2)
  89. INTEGER IVALIS(N2)
  90. REAL*8 XVAL(N2)
  91. ENDSEGMENT
  92. SEGMENT INFO
  93. integer INFELL(IU)
  94. ENDSEGMENT
  95.  
  96. C PARALLELISATION PTHREAD
  97. SEGMENT SPARAL
  98. INTEGER NNN,ML1,ML2,MPV1,MPV2,MCH1,MEL2,
  99. & N1ELP,N1PELP
  100. INTEGER IXX(NBTHR)
  101. ENDSEGMENT
  102.  
  103. SEGMENT SXX
  104. REAL*8 XX(NDIM)
  105. ENDSEGMENT
  106. C
  107. C Introduction d'un COMMON pour la parallelisation
  108. COMMON/IPLMUC/IPARAL
  109. EXTERNAL IPMULi
  110.  
  111. DATA NOMTT/'T '/
  112. DATA NOMSIM/'SIMU'/
  113. iptamo = 0
  114. KREAL = .TRUE.
  115. C
  116. JEMIL1 = JEMIL
  117. dstati = .false.
  118. C
  119. C Pour la paralelisation de l'interpolation
  120. C
  121. IPARAL= 0
  122. BTHRD = .FALSE.
  123. MCHAM2= 0
  124. IPOIN1= 0
  125. C
  126. INUBF4 = 0
  127. C
  128. C CONVERSION DU CHPOINT OU MCHAML EN MCHAML AU SUPORT DEMANDE
  129. IF (MICHE.EQ.1) THEN
  130. CALL CHAME1(0,IPMODL,IPOI2,' ',IPOI3,JEMIL1)
  131. IF (IERR.NE.0) RETURN
  132. ELSE
  133. *
  134. * AM 14/6/07
  135. * ON PASSE UN INDICATEUR DE SUPPORT NEGATIF A CHASUP
  136. * POUR EVITER DES PROBLEMES DE CHANGEMENT DE SUPPORT
  137. * DE VARIABLES INTERNES NON SCALAIRES, DANS CHASUP
  138. *
  139. JEMIL2 = - JEMIL1
  140. CALL CHASUP(IPMODL,IPOI2,IPOI3,IRT2,JEMIL2)
  141. IF (IRT2.NE.0) THEN
  142. CALL ERREUR(IRT2)
  143. RETURN
  144. ENDIF
  145. ENDIF
  146. C
  147. C ACTIVATION DU MODELE
  148. MMODEL=IPMODL
  149. NSOUS1=KMODEL(/1)
  150. C
  151. C ACTIVATION DES MCHELM
  152. MCHEL1=IPOI1
  153. NSOUS=MCHEL1.ICHAML(/1)
  154. IF (NSOUS.GT.NSOUS1) THEN
  155. CALL ERREUR(553)
  156. RETURN
  157. ENDIF
  158. NINF=MCHEL1.INFCHE(/2)
  159. C
  160. C Creation du MCHAML
  161. N1=NSOUS
  162. N3=6
  163. IF (CHARP.EQ.' ') THEN
  164. L1=MCHEL1.TITCHE(/1)
  165. SOUTYP=MCHEL1.TITCHE
  166. ELSE
  167. L1=LEN(CHARP)
  168. SOUTYP=CHARP
  169. ENDIF
  170. SEGINI MCHELM
  171. IRET=MCHELM
  172. IFOCHE=IFOUR
  173. TITCHE=SOUTYP
  174. C
  175. C Boucle sur les sous zone du MCHAML
  176. DO 10 ISOUS=1,NSOUS
  177. C
  178. JEMIL1 = JEMIL
  179. C
  180. C VALEURS INITIALES
  181. MCHEL2=0
  182. IYOUN=0
  183. IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)
  184. CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)
  185. DO 20 IP=1,NINF
  186. INFCHE(ISOUS,IP)=MCHEL1.INFCHE(ISOUS,IP)
  187. 20 CONTINUE
  188. C
  189. C Mise en concordance des pointeurs de maillage
  190. C
  191. MELEME=IMACHE(ISOUS)
  192. C* DO 30 IO=1,kmodel(/1)
  193. DO 30 IO=1, NSOUS1
  194. IMODEL=KMODEL(IO)
  195. if (cmatee.eq.'STATIQUE') dstati = .true.
  196. IF (IMAMOD.EQ.MELEME.AND.CONMOD.EQ.CONCHE(ISOUS)) GOTO 40
  197. 30 CONTINUE
  198. CALL ERREUR(472)
  199. GOTO 9930
  200. 40 CONTINUE
  201. IMELE=NEFMOD
  202. C
  203. C Le modèle est-il appuye sur des elements coques.
  204. C MF1 = 3 ---> coque
  205. C MF1 = 5 ---> coque epaisse
  206. C MF1 = 9 ---> coque avec cisaillement transverse
  207. C
  208. MF1 = NUMMFR(NEFMOD)
  209. COQ = (MF1 .EQ. 3).OR.(MF1 .EQ. 5).OR.(MF1 .EQ. 9)
  210.  
  211. C Pour un modele thermique, le support/segment d'integration est specifique
  212. C idem pour la DIFFUSION en attendant un retour a equivalence a la MECANIQUE !!
  213. IF ( JEMIL1 .NE. 1 ) THEN
  214. NFORQ = FORMOD(/2)
  215. ither = 0
  216. idiff = 0
  217. imeta = 0
  218. CALL PLACE(FORMOD,NFORQ,ither,'THERMIQUE')
  219. CALL PLACE(FORMOD,NFORQ,idiff,'DIFFUSION')
  220. CALL PLACE(FORMOD,NFORQ,imeta,'METALLURGIE')
  221. CALL PLACE(FORMOD,NFORQ,ichph,'CHANGEMENT_PHASE')
  222. IF (ither.NE.0 .OR. idiff.NE.0 .OR.
  223. & imeta.NE.0 .OR. ichph.NE.0) JEMIL1 = 6
  224. ENDIF
  225. C
  226. IPTR3=0
  227. IF (NINF.LT.4.OR.MCHEL1.INFCHE(ISOUS,4).EQ.0) THEN
  228. IF (JEMIL1 .EQ. 6) THEN
  229. CALL TSHAPE(IMELE,'NOEUD',MINTE1)
  230. IF (IERR.NE.0) GOTO 9930
  231. C#MC 08/04/98
  232. ELSE
  233. IF (INFMOD(/1).lt.3) then
  234. CALL ELQUOI(IMELE,0,1,IPTR3,IMODEL)
  235. IF (IERR.NE.0) GOTO 9930
  236. info=IPTR3
  237. MINTE1=info.INFELL(11)
  238. segsup,info
  239. ELSE
  240. MINTE1=INFMOD(3)
  241. ENDIF
  242. ENDIF
  243. C La sous-zone est aux noeuds :
  244. ELSE
  245. MINTE1=MCHEL1.INFCHE(ISOUS,4)
  246. ENDIF
  247. C
  248. C Information sur l'element fini
  249. IF (JEMIL1 .EQ. 6) THEN
  250. CALL TSHAPE(IMELE,'GAUSS',MINTE)
  251. IF (IERR.NE.0) GOTO 9920
  252. MELGEO = NUMGEO(IMELE)
  253. ELSE
  254. IF(INFMOD(/1).lt.2+JEMIL1) then
  255. CALL ELQUOI(IMELE,0,JEMIL1,IPTR2,IMODEL)
  256. IF (IERR.NE.0) GOTO 9920
  257. info=IPTR2
  258. MINTE =info.INFELL(11)
  259. MELGEO=info.INFELL(14)
  260. segsup,info
  261. ELSE
  262. MINTE =INFMOD(2+JEMIL1)
  263. MELGEO=INFELE(14)
  264. ENDIF
  265. ENDIF
  266. INFCHE(ISOUS,4)=MINTE
  267. IF (JEMIL1.EQ.1) INFCHE(ISOUS,4)=0
  268. INFCHE(ISOUS,6)=JEMIL1
  269. C
  270. C On recupere le nombre de points support NBPGA1 pour
  271. C pour l'ancien chamelem NBPGAU pour le nouveau mchaml
  272. NBPGA1 = MINTE1.SHPTOT(/3)
  273. NBPGAU = SHPTOT(/3)
  274. C
  275. C On recupere le nombre d'elements
  276. NBN1=NUM(/1)
  277. NEL0=NUM(/2)
  278. SEGINI SWORK
  279. C
  280. C CREATION DU MCHAML
  281. MCHAM1=MCHEL1.ICHAML(ISOUS)
  282. N2=MCHAM1.NOMCHE(/2)
  283. SEGINI MCHAML
  284. ICHAML(ISOUS)=MCHAML
  285.  
  286. NMATQ =MATMOD(/2)
  287. iuser = 0
  288. CALL PLACE(MATMOD,NMATQ,iuser,'UTILISATEUR')
  289. CMNAME=' '
  290. IF (iuser.GT.0) THEN
  291. IF (iuser.LT.NMATQ) CMNAME = MATMOD(iuser+1)
  292. ENDIF
  293. *
  294. KNUAG = .FALSE.
  295. IF (TITCHE.EQ.'CARACTERISTIQUES') THEN
  296. DO 60 IC1=1,N2
  297. IF (MCHAM1.NOMCHE(IC1).EQ.'YOUN ') IYOUN=IC1
  298. CHA1=MCHAM1.TYPCHE(IC1)
  299. IF (CHA1(9:16).EQ.'NUAGE ') KNUAG = .TRUE.
  300. 60 CONTINUE
  301. IF (KNUAG) THEN
  302. SEGINI WRK53
  303. wrk53.MFR = MF1
  304. wrk53.NFOR = NFORQ
  305. wrk53.NMAT = NMATQ
  306. wrk53.CMATE = CMATEE
  307. wrk53.MATE = IMATEE
  308. wrk53.INPLAS = INATUU
  309. if(lnomid(6).ne.0) then
  310. nomid=lnomid(6)
  311. ipnomc=nomid
  312. nbrobl=lesobl(/2)
  313. nbrfac=lesfac(/2)
  314. lsupma=.false.
  315. else
  316. lsupma=.true.
  317. CALL IDMATR(MF1,IMODEL,IPNOMC,NBROBL,NBRFAC)
  318. endif
  319. IQMOD=IMODEL
  320. IWRK53=WRK53
  321. NMATT=NBROBL+NBRFAC
  322. CALL COTYPE(IQMOD,13,MOTYPE,IWRK53,NBROBL,NBRFAC)
  323. NOTYPE=MOTYPE
  324. SEGACT NOTYPE
  325. NBTYPE=TYPE(/2)
  326. KREAL = .TRUE.
  327. DO 65 ITYPE=1,NBTYPE
  328. TYPV=TYPE(ITYPE)
  329. IF (TYPV(1:6).NE.'REAL*8') KREAL = .FALSE.
  330. 65 CONTINUE
  331. SEGDES NOTYPE
  332. SEGSUP WRK53
  333. ENDIF
  334. ENDIF
  335. C
  336. SEGINI WRK53
  337. SEGINI WRKRES
  338. JESIMU = 0
  339. C
  340. C'''''''''''''''''''''''''''''''''''''
  341. C BOUCLE SUR LES COMPOSANTES
  342. C
  343. C'''''''''''''''''''''''''''''''''''''
  344. DO 70 ICOMP=1,N2
  345. IAMOI=0
  346. C
  347. C traitement des composantes de type FLOTTANT ou MCHAML
  348. C
  349. CHA1=MCHAM1.TYPCHE(ICOMP)
  350. NOMCHE(ICOMP)=MCHAM1.NOMCHE(ICOMP)
  351. NOMCO = MCHAM1.NOMCHE(ICOMP)
  352. NOMVAL(ICOMP) = MCHAM1.NOMCHE(ICOMP)(1:4)
  353. MELVA1=MCHAM1.IELVAL(ICOMP)
  354. C
  355. C---------------------------------------------------------
  356. C Composante de type reel
  357. C---------------------------------------------------------
  358. C
  359. IF (CHA1(1:8).EQ.'REAL*8 ') THEN
  360. TYPCHE(ICOMP)='REAL*8'
  361. N1PTE1=MELVA1.VELCHE(/1)
  362. IF (N1PTE1.EQ.1) THEN
  363. N1PTEL=1
  364. ELSE
  365. N1PTEL=NBPGAU
  366. ENDIF
  367. N1EL =MELVA1.VELCHE(/2)
  368. N2PTEL=0
  369. N2EL =0
  370. C
  371. C test de compatibilite des nombres d'elements
  372. C
  373. IF (N1EL.NE.NEL0.AND.N1EL.NE.1.AND.NEL0.NE.1) THEN
  374. MOTERR(1:8)='VARINU '
  375. CALL ERREUR(146)
  376. GOTO 9910
  377. ENDIF
  378. N1PAUX=N1PTE1
  379. C
  380. C Pour les COQ4, le nb de pt de GAUSS vaut 5, mais on
  381. C ne prend que les 4 premiers (le 5ieme sert uniquement
  382. C au cisaillement)
  383. IF (IMELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  384. SEGINI MELVAL
  385. IELVAL(ICOMP)=MELVAL
  386. C
  387. C Traitement immediat si champ constant
  388. IF (N1PTE1.EQ.1) THEN
  389. DO 80 IEL=1,N1EL
  390. VELCHE(1,IEL)=MELVA1.VELCHE(1,IEL)
  391. 80 CONTINUE
  392. ELSE
  393. DO 90 IEL=1,NEL0
  394. DO 100 IGAU=1,N1PTE1
  395. VAL1(IGAU)=MELVA1.VELCHE(IGAU,IEL)
  396. 100 CONTINUE
  397. C
  398. C LE CHAMELEM N'EST PAS AUX NOEUDS
  399. IF (MINTE1.NE.0) THEN
  400. C Meme support
  401. IF (MINTE.EQ.MINTE1) THEN
  402. DO 110 IGAU=1,N1PTE1
  403. VELCHE(IGAU,IEL)=VAL1(IGAU)
  404. 110 CONTINUE
  405. GOTO 90
  406. C Support different
  407. ELSE
  408. CALL DOXE(XCOOR,IDIM,NBN1,NUM,IEL,XE)
  409. CALL QUEDIM(MELGEO,KERRE1)
  410. CALL CH1CH2(IMELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBN1,
  411. & SWORK,IPOIN1,KERRE1)
  412. IF (KERRE1.NE.0) THEN
  413. CALL ERREUR(KERRE1)
  414. GOTO 9900
  415. ENDIF
  416. DO 120 IGAU=1,N1PTEL
  417. VELCHE(IGAU,IEL)=VAL2(IGAU)
  418. 120 CONTINUE
  419. ENDIF
  420. ELSE
  421. DO 130 IGAU=1,N1PTEL
  422. VALG=0.D0
  423. DO 140 INO=1,NBN1
  424. VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  425. 140 CONTINUE
  426. VELCHE(IGAU,IEL)=VALG
  427. 130 CONTINUE
  428. ENDIF
  429. 90 CONTINUE
  430. ENDIF
  431. C
  432. C---------------------------------------------------------
  433. C Composante de type evolution
  434. C---------------------------------------------------------
  435. C
  436. ELSE IF (CHA1(9:16).EQ.'EVOLUTIO') THEN
  437. N1PTE3=MELVA1.IELCHE(/1)
  438. N1EL3 =MELVA1.IELCHE(/2)
  439. IF (N1EL3.NE.NEL0.AND.N1EL3.NE.1.AND.NEL0.NE.1) THEN
  440. MOTERR(1:8)='VARINU '
  441. CALL ERREUR(146)
  442. GOTO 9910
  443. ENDIF
  444. C
  445. C S'il s'agit d'une courbe de traction d'un matériau
  446. C constant, on garde l'objet EVOLUTIO sans rien changer.
  447. C
  448. NOMTMP=NOMCHE(ICOMP)
  449. IF (TITCHE.EQ.'CARACTERISTIQUES'.AND.
  450. & N1PTE3.EQ.1.AND.N1EL3.EQ.1) THEN
  451. IF (NOMTMP.EQ.'TRAC '.OR.NOMTMP.EQ.'EVOL '.OR.
  452. & NOMTMP.EQ.'COMP '.OR.NOMTMP.EQ.'FLXY '.OR.
  453. & NOMTMP.EQ.'FLXZ '.OR.NOMTMP.EQ.'CISY '.OR.
  454. & NOMTMP.EQ.'CISZ '.OR.NOMTMP.EQ.'JDA '.OR.
  455. & NOMTMP.EQ.'EM0 '.OR.NOMTMP.EQ.'EM1 '.OR.
  456. & NOMTMP.EQ.'EM2 '.OR.NOMTMP.EQ.'EM3 '.OR.
  457. & NOMTMP.EQ.'EM4 '.OR.NOMTMP.EQ.'EM5 '.OR.
  458. & NOMTMP.EQ.'EM6 '.OR.NOMTMP.EQ.'EM7 '.OR.
  459. & NOMTMP.EQ.'EM8 '.OR.NOMTMP.EQ.'SFFS '.OR.
  460. & NOMTMP.EQ.'EFFS '.OR.NOMTMP.EQ.'SJCB '.OR.
  461. & NOMTMP.EQ.'SJTB '.OR.NOMTMP.EQ.'SJSB '.OR.
  462. & NOMTMP.EQ.'ECRO') THEN
  463. TYPCHE(ICOMP)='POINTEUREVOLUTIO'
  464. N1PTEL=0
  465. N1EL =0
  466. N2PTEL=1
  467. N2EL =1
  468. SEGINI MELVAL
  469. IELVAL(ICOMP)=MELVAL
  470. IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1)
  471. GOTO 70
  472. ENDIF
  473. ENDIF
  474. C
  475. C S'il s'agit d'autres composantes que la courbe de
  476. C traction d'un matériau constant on fait l'interpolation
  477. C selon la loi de variation
  478. C
  479. TYPCHE(ICOMP)='REAL*8'
  480. MCHEL2=IPOI3
  481. IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN
  482. CALL ERREUR(553)
  483. GOTO 9910
  484. ENDIF
  485. IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR.
  486. & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN
  487. do is = 1,mchel2.imache(/1)
  488. if (imamod.eq.mchel2.imache(is).and.
  489. & conmod.eq.mchel2.conche(is)) then
  490. icham2 = mchel2.ichaml(is)
  491. goto 149
  492. endif
  493. enddo
  494. CALL ERREUR(472)
  495. GOTO 9910
  496. ELSE
  497. ICHAM2=MCHEL2.ICHAML(ISOUS)
  498. ENDIF
  499. C
  500. 149 CONTINUE
  501. iptamo = 0
  502. if (inatuu.eq.164.and.NOMTMP.eq.'MOCO') then
  503. N=1
  504. segini mevol1,mevol2
  505. segini,melva2=melva1
  506. segini,melva3=melva1
  507. drev21 = .false.
  508. drev22 = .true.
  509. do iel = 1,melva2.ielche(/2)
  510. do ipg = 1,melva2.ielche(/1)
  511. MEVOLL = MELVA2.IELCHE(ipg,iel)
  512. KEVOLL = IEVOLL(1)
  513. mevol1.ievoll(1) = ievoll(1)
  514. melva2.ielche(ipg,iel) = mevol1
  515. if (ievoll(/1).gt.1) then
  516. mevol2.ievoll(1) = ievoll(2)
  517. melva3.ielche(ipg,iel) = mevol2
  518. drev21 = .true.
  519. else
  520. drev22 = .false.
  521. endif
  522. enddo
  523. enddo
  524. CALL VARIN2(ICHAM2,melva2,COQ,MELEME,SWORK,NOMCO,IMELE,
  525. & MELGEO,MINTE,MINTE1,MELVAL,KERRE1)
  526. C iptrai = melval
  527. nomche(icomp) = 'RAID'
  528. if (drev21.and.drev22) then
  529. CALL VARIN2(ICHAM2,melva3,COQ,MELEME,SWORK,NOMCO,IMELE,
  530. & MELGEO,MINTE,MINTE1,MELVAL,KERRE1)
  531. iptamo = melval
  532. endif
  533. c if (.not.drev22) write(6,*) 'AMOR problématique',kerre1
  534. c melval = iptrai
  535.  
  536. else
  537. CALL VARIN2(ICHAM2,MELVA1,COQ,MELEME,SWORK,NOMCO,IMELE,
  538. & MELGEO,MINTE,MINTE1,MELVAL,KERRE1)
  539. endif
  540. C
  541. IF (KERRE1.NE.0) THEN
  542. IF (KERRE1.EQ.146) MOTERR(1:8)='VARINU '
  543. CALL ERREUR(KERRE1)
  544. GOTO 9910
  545. ENDIF
  546. IELVAL(ICOMP)=MELVAL
  547. C
  548. C---------------------------------------------------------
  549. C Composante de type nuage
  550. C---------------------------------------------------------
  551. C
  552. ELSE IF (CHA1(9:16).EQ.'NUAGE ') THEN
  553. INUBF4 = MELVA1.IELCHE(1,1)
  554. MNUAG1 = INUBF4
  555. NVAR = MNUAG1.NUANOM(/2)
  556. IF (NVAR.LE.1) THEN
  557. INTERR(1)=MNUAG1
  558. INTERR(2)=2
  559. INTERR(3)=2
  560. CALL ERREUR(628)
  561. GOTO 9910
  562. ENDIF
  563. C Depouillement du nuage pour connaitre le nombre de dimensions de
  564. C la grille
  565. NNU=MNUAG1.NUAPOI(/1)
  566. NDIM=NNU-1
  567. IF (NDIM.LT.1) THEN
  568. INTERR(1)=MNUAG1
  569. INTERR(2)=2
  570. INTERR(3)=1
  571. CALL ERREUR(628)
  572. RETURN
  573. ENDIF
  574. C
  575. C Initialisation d'une liste de mots pour stocker les noms des
  576. C dimensions de la grille
  577. JGN=4
  578. JGM=NNU
  579. SEGINI,MLMOT1
  580. C
  581. C Parcours du NUAGE pour verifications noms
  582. dnua1 = .false.
  583. knuch2 = 0
  584. DO I=1,NNU
  585. C Nom de la composante I
  586. MOT1=MNUAG1.NUANOM(I)
  587. C Et rangement du mot dans la liste de mots adhoc
  588. MLMOT1.MOTS(I)=MOT1
  589. if (mot1.eq.NOMCHE(ICOMP)) dnua1 = .true.
  590. ENDDO
  591. * recherche adéquation nuage / paramètres
  592. IF (DNUA1) THEN
  593. MCHEL2=IPOI3
  594. IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN
  595. CALL ERREUR(553)
  596. GOTO 9910
  597. ENDIF
  598. IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR.
  599. & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN
  600. do is = 1,mchel2.imache(/1)
  601. if (imamod.eq.mchel2.imache(is).and.
  602. & conmod.eq.mchel2.conche(is)) then
  603. icham2 = mchel2.ichaml(is)
  604. goto 259
  605. endif
  606. enddo
  607. CALL ERREUR(472)
  608. GOTO 9910
  609. ELSE
  610. ICHAM2=MCHEL2.ICHAML(ISOUS)
  611. ENDIF
  612. C
  613. 259 CONTINUE
  614. C
  615. MCHAM2 = ICHAM2
  616. NCO1 = MCHAM2.IELVAL(/1)
  617. INO1 = 0
  618. INO3 = 0
  619. do ii = 1,nnu
  620. knuch3 = 0
  621. DO INO = 1,NCO1
  622. NOM2 = MCHAM2.NOMCHE(INO)
  623. if (nom2.eq.mlmot1.mots(ii).and.
  624. &mcham2.typche(ino)(1:8).eq.'REAL*8 ') knuch3 = knuch3 + 1
  625. ENDDO
  626. if (knuch3.eq.1) knuch2 = knuch2 + 1
  627. enddo
  628.  
  629.  
  630. ELSE
  631. * recopie
  632. TYPCHE(ICOMP)='POINTEURNUAGE '
  633. N1PTEL=0
  634. N1EL =0
  635. N2PTEL=1
  636. N2EL =1
  637. SEGINI MELVAL
  638. IELVAL(ICOMP)=MELVAL
  639. IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1)
  640. SEGSUP MLMOT1
  641. GOTO 70
  642.  
  643. ENDIF
  644.  
  645. C interpolation grille reprend fonctionnalité de IPOL / z = f(x,y)
  646. if(knuch2.ge.2) then
  647. TYPCHE(ICOMP)='REAL*8'
  648. N2EL = MELVA1.IELCHE(/2)
  649. N2PTEL = MELVA1.IELCHE(/1)
  650. C
  651. C test de compatibilite des nombres d'elements
  652. C
  653. IF (N2EL.NE.1.OR.N2PTEL.NE.1) THEN
  654. MOTERR(1:8)='VARINU '
  655. CALL ERREUR(146)
  656. GOTO 9910
  657. ENDIF
  658. C
  659.  
  660. MCHAM2 = ICHAM2
  661. NCO1 = MCHAM2.IELVAL(/1)
  662. INUBF4 = MELVA1.IELCHE(1,1)
  663. MNUAG1 = INUBF4
  664. NVAR = MNUAG1.NUANOM(/2)
  665. IF (NVAR.LE.1) THEN
  666. INTERR(1)=MNUAG1
  667. INTERR(2)=2
  668. INTERR(3)=2
  669. CALL ERREUR(628)
  670. GOTO 9910
  671. ENDIF
  672. C
  673. INO1 = 0
  674. INO3 = 0
  675. DO INO = 1,NCO1
  676. NOM2 = MCHAM2.NOMCHE(INO)
  677. do i = 1,nnu
  678. if (nom2.eq.mlmot1.mots(i)) then
  679. if (ino1.eq.0) ino1 = ino
  680. if (ino1.ne.0) ino3 = ino
  681. endif
  682. enddo
  683. ENDDO
  684. IF (INO1.NE.0.AND.INO3.NE.0) THEN
  685. MELVA3=MCHAM2.IELVAL(INO1)
  686. MELVA4=MCHAM2.IELVAL(INO3)
  687. ELSE
  688.  
  689. CALL ERREUR(665)
  690. GOTO 9910
  691. ENDIF
  692. C
  693. C Depouillement du nuage pour connaitre le nombre de dimensions de
  694. C la grille
  695. NNU=MNUAG1.NUAPOI(/1)
  696. NDIM=NNU-1
  697. IF (NDIM.LT.1) THEN
  698. INTERR(1)=MNUAG1
  699. INTERR(2)=2
  700. INTERR(3)=1
  701. CALL ERREUR(628)
  702. RETURN
  703. ENDIF
  704. C
  705. C Initialisation d'une liste de mots pour stocker les noms des
  706. C dimensions de la grille
  707. JGN=4
  708. JGM=NNU
  709. * SEGINI,MLMOT1
  710. C
  711. C Iniilisation d'une liste d'entiers pour stocker les pointeurs vers
  712. C les LISTREEL definissant la grille de valeur de la fonction F
  713. JG=NNU
  714. SEGINI,MLENT1
  715. C
  716. C Parcours du NUAGE pour verifications
  717. NVAL=1
  718. DO I=1,NNU
  719. C Nom de la composante I
  720. MOT1=MNUAG1.NUANOM(I)
  721. C Et rangement du mot dans la liste de mots adhoc
  722. * MLMOT1.MOTS(I)=MOT1
  723. C Les composantes doivent abriter 1 seul objet de type LISTREEL
  724. MOT2=MNUAG1.NUATYP(I)
  725. IF (MOT2.NE.'LISTREEL') THEN
  726. CALL ERREUR(941)
  727. RETURN
  728. ENDIF
  729. NUAVI1=MNUAG1.NUAPOI(I)
  730. NPO=NUAVI1.NUAINT(/1)
  731. IF (NPO.NE.1) THEN
  732. CALL ERREUR(941)
  733. RETURN
  734. ENDIF
  735. MLREE1=NUAVI1.NUAINT(1)
  736. C Verification de la taille de la derniere liste
  737. IF (I.EQ.NNU) THEN
  738. NTEST=MLREE1.PROG(/1)
  739. IF (NTEST.NE.NVAL) THEN
  740. CALL ERREUR(21)
  741. RETURN
  742. ENDIF
  743. ELSE
  744. NVAL=NVAL*(MLREE1.PROG(/1))
  745. ENDIF
  746. C Et rangement du pointeur dans la liste d'entiers adhoc
  747. MLENT1.LECT(I)=MLREE1
  748. ENDDO
  749.  
  750. C Liste de correspondance entre les composantes du MCHAML et les
  751. C noms des dimensions de la grille
  752. C MLENT2.LECT(i) = numero de la composante de MCHAM1
  753. C correspondante a la dimension i de la grille
  754. JG=NNU
  755. SEGINI,MLENT2
  756. N1PTEL=0
  757. N1EL=0
  758. N2PTEL=0
  759. N2EL=0
  760. DO K=1,NDIM
  761. MOT2=MLMOT1.MOTS(K)
  762. JVAL1=0
  763. DO J=1,MCHAM2.IELVAL(/1)
  764. MOT1=MCHAM2.NOMCHE(J)
  765. IF (MOT1.EQ.MOT2) THEN
  766. JVAL1=K
  767. GOTO 2
  768. ENDIF
  769. ENDDO
  770. C Cas ou une composante du MCHAML ne se retrouve pas dans les
  771. C noms des dimensions de la grille
  772. 2 IF (JVAL1.EQ.0) THEN
  773. CALL ERREUR(665)
  774. RETURN
  775. ENDIF
  776. MLENT2.LECT(JVAL1)=J
  777. C Verification que le champ contient des flottants,
  778. IF (MCHAM2.TYPCHE(J).NE.'REAL*8') THEN
  779. MOTERR(1:16) = MCHAM2.TYPCHE(J)
  780. MOTERR(17:20) = MOT1
  781. MOTERR(21:29) = 'argument'
  782. CALL ERREUR(552)
  783. RETURN
  784. ENDIF
  785. C Recherche des tailles MAX des MELVAL de chaque composante de
  786. C cette sous zone (pour preparer le champ de sortie)
  787. MELVA1=MCHAM2.IELVAL(J)
  788. N1PTEL=MAX(N1PTEL,MELVA1.VELCHE(/1))
  789. N1EL =MAX(N1EL ,MELVA1.VELCHE(/2))
  790. ENDDO
  791. C Initialisation du tableau de valeurs (MELVA2) du sous champ
  792. C de sortie
  793. SEGINI,MELVA2
  794.  
  795. C Preparation pour le calcul en parallele
  796. C Regalge fait sur PC40 pour determiner le nombre de NOEUDS optimum
  797. C par thread
  798. IOPTIM = 100
  799. N1 = N1EL / IOPTIM
  800.  
  801. ITH = 0
  802. IF (NBESC .NE. 0) ITH=oothrd
  803. C CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  804. C DEJA DANS LES ASSISTANTS
  805. IF ((N1.LE.1) .OR. (NBTHRS .EQ. 1) .OR. (ITH .GT. 0)) THEN
  806. NBTHR = 1
  807. BTHRD = .FALSE.
  808. ELSE
  809. BTHRD = .TRUE.
  810. NBTHR = MIN(N1, NBTHRS)
  811. CALL THREADII
  812. ENDIF
  813.  
  814. SEGINI,SPARAL
  815. DO ITH=1,NBTHR
  816. SEGINI,SXX
  817. SPARAL.IXX(ITH) = SXX
  818. ENDDO
  819.  
  820. SPARAL.NNN = 0
  821. SPARAL.ML1 = MLENT1
  822. SPARAL.ML2 = MLENT2
  823. SPARAL.MPV1 = 0
  824. SPARAL.MPV2 = 0
  825. SPARAL.MCH1 = MCHAM1
  826. SPARAL.MEL2 = MELVA2
  827. SPARAL.N1ELP = N1EL
  828. SPARAL.N1PELP = N1PTEL
  829.  
  830. C Lancement des Threads
  831. IF (BTHRD) THEN
  832. IPARAL=SPARAL
  833. DO ITH=2,NBTHR
  834. CALL THREADID(ITH,IPMULI)
  835. ENDDO
  836. CALL IPMULI(1)
  837.  
  838. DO ITH=2,NBTHR
  839. CALL THREADIF(ITH)
  840. ENDDO
  841.  
  842. CALL THREADIS
  843. ELSE
  844. CALL IPMULI(1)
  845. ENDIF
  846. C On le range dans le MCHAML global
  847. IELVAL(ICOMP)=MELVA2
  848. SEGSUP MLMOT1,MLENT1,MLENT2
  849.  
  850. DO ITH=1,NBTHR
  851. SXX = SPARAL.IXX(ITH)
  852. SEGSUP,SXX
  853. ENDDO
  854. SEGSUP,SPARAL
  855. *
  856. GOTO 70
  857. endif
  858.  
  859. * autres cas
  860. TYPCHE(ICOMP)='POINTEUREVOLUTIO'
  861. MCHEL2=IPOI3
  862. NSOUS2=MCHEL2.ICHAML(/1)
  863. IF (NSOUS2.GT.NSOUS1.OR.NSOUS2.LT.NSOUS) THEN
  864. CALL ERREUR(553)
  865. GOTO 9910
  866. ENDIF
  867. C Mise en concordance des pointeurs de maillage
  868. DO 150 IP=1,NSOUS
  869. IF (MCHEL2.IMACHE(IP).EQ.MELEME.AND.
  870. & MCHEL2.CONCHE(IP).EQ.CONCHE(ISOUS)) GOTO 160
  871. 150 CONTINUE
  872. CALL ERREUR(472)
  873. GOTO 9930
  874. 160 CONTINUE
  875. MCHAM2=MCHEL2.ICHAML(IP)
  876. C
  877. NCO1 = MCHAM2.IELVAL(/1)
  878. INU = MELVA1.IELCHE(1,1)
  879. MNUAGE = INU
  880. NVAR = NUANOM(/2)
  881. IF (NVAR.LE.1) THEN
  882. INTERR(1)=MNUAGE
  883. INTERR(2)=2
  884. INTERR(3)=2
  885. CALL ERREUR(628)
  886. GOTO 9910
  887. ENDIF
  888. C
  889. NOM4 = ' '
  890. NOM5 = ' '
  891. IA1 = 0
  892. IA2 = 0
  893. IVAR = 0
  894. DO 170 INO2=1,NVAR
  895. TYP3 = NUATYP(INO2)
  896. IF (TYP3.EQ.'FLOTTANT') THEN
  897. IF (IVAR.EQ.0) THEN
  898. NOM4 = NUANOM(INO2)
  899. IA1 = INO2
  900. ENDIF
  901. IF (IVAR.EQ.1) THEN
  902. NOM5 = NUANOM(INO2)
  903. IA2 = INO2
  904. ENDIF
  905. IVAR = IVAR + 1
  906. ENDIF
  907. 170 CONTINUE
  908. IF (IVAR.LT.1) THEN
  909. INTERR(1)=MNUAGE
  910. MOTERR(1:8)='FLOTTANT'
  911. CALL ERREUR(629)
  912. GOTO 9910
  913. ENDIF
  914. IF (IVAR.GT.2) THEN
  915. INTERR(1)=MNUAGE
  916. INTERR(2)=2
  917. CALL ERREUR(938)
  918. GOTO 9910
  919. ENDIF
  920. IF (NOM4.EQ.NOM5) THEN
  921. INTERR(1)=MNUAGE
  922. MOTERR(1:8)='FLOTTANT'
  923. CALL ERREUR(939)
  924. GOTO 9910
  925. ENDIF
  926. C
  927. DO 180 IBBON=1,NVAR
  928. IF (NUATYP(IBBON).EQ.'EVOLUTIO') GOTO 190
  929. 180 CONTINUE
  930. INTERR(1)=MNUAGE
  931. MOTERR(1:8)='EVOLUTIO'
  932. CALL ERREUR(629)
  933. GOTO 9910
  934. 190 CONTINUE
  935. C
  936. C Cas des coques dont les caracteristiques dependent de T
  937. C
  938. IF (COQ.AND.
  939. & ((NOM4.EQ.NOMTT).OR.(NOM5.EQ.NOMTT))) THEN
  940. INO2 = 0
  941. INO1 = 0
  942. INO3 = 0
  943. DO 200 INO = 1,NCO1
  944. NOM2 = MCHAM2.NOMCHE(INO)
  945. IF (NOM2.EQ.NOMTT) INO2=INO
  946. IF (NOM2.EQ.'TINF ') INO1=INO
  947. IF (NOM2.EQ.'TSUP ') INO3=INO
  948. 200 CONTINUE
  949. IF (INO1.NE.0.AND.INO2.NE.0.AND.INO3.NE.0) THEN
  950. MELVA3=MCHAM2.IELVAL(INO1)
  951. MELVA4=MCHAM2.IELVAL(INO3)
  952. C
  953. NBP2=MELVA4.VELCHE(/1)
  954. NBP1=MELVA3.VELCHE(/1)
  955. NEL1=MELVA3.VELCHE(/2)
  956. NEL2=MELVA4.VELCHE(/2)
  957. N1PTEL=MAX(NBP1,NBP2)
  958. N1EL =MAX(NEL1,NEL2)
  959. N2PTEL=0
  960. N2EL =0
  961. SEGINI MELVA5
  962. DO 210 IGAU=1,N1PTEL
  963. IGMN1=MIN(IGAU,MELVA3.VELCHE(/1))
  964. IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))
  965. DO 220 IB=1,N1EL
  966. IBMN1=MIN(IB ,MELVA3.VELCHE(/2))
  967. IBMN2=MIN(IB ,MELVA4.VELCHE(/2))
  968. MELVA5.VELCHE(IGAU,IB)=MELVA3.VELCHE(IGMN1,IBMN1)+
  969. & MELVA4.VELCHE(IGMN2,IBMN2)
  970. 220 CONTINUE
  971. 210 CONTINUE
  972. C
  973. MELVA3=MCHAM2.IELVAL(INO2)
  974. N1PTEL = MELVA3.VELCHE(/1)
  975. N1EL = MELVA3.VELCHE(/2)
  976. N2PTEL = 0
  977. N2EL = 0
  978. SEGINI MELVA4
  979. DO 230 II = 1,N1PTEL
  980. DO 240 III = 1,N1EL
  981. MELVA4.VELCHE(II,III) = 4.D0*MELVA3.VELCHE(II,III)
  982. 240 CONTINUE
  983. 230 CONTINUE
  984. C
  985. NBP2=MELVA4.VELCHE(/1)
  986. NBP1=MELVA5.VELCHE(/1)
  987. NEL1=MELVA5.VELCHE(/2)
  988. NEL2=MELVA4.VELCHE(/2)
  989. N1PTEL=MAX(NBP1,NBP2)
  990. N1EL =MAX(NEL1,NEL2)
  991. N2PTEL=0
  992. N2EL =0
  993. SEGINI MELVA6
  994. DO 250 IGAU=1,N1PTEL
  995. IGMN1=MIN(IGAU,MELVA5.VELCHE(/1))
  996. IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))
  997. DO 260 IB=1,N1EL
  998. IBMN1=MIN(IB ,MELVA5.VELCHE(/2))
  999. IBMN2=MIN(IB ,MELVA4.VELCHE(/2))
  1000. MELVA6.VELCHE(IGAU,IB)=MELVA5.VELCHE(IGMN1,IBMN1)+
  1001. & MELVA4.VELCHE(IGMN2,IBMN2)
  1002. 260 CONTINUE
  1003. 250 CONTINUE
  1004. SEGSUP MELVA4,MELVA5
  1005. C
  1006. N1PTEL = MELVA6.VELCHE(/1)
  1007. N1EL = MELVA6.VELCHE(/2)
  1008. N2PTEL = 0
  1009. N2EL = 0
  1010. IF (NOM4.EQ.NOMTT) THEN
  1011. SEGINI MELVA2
  1012. DO 270 II = 1,N1PTEL
  1013. DO 280 III = 1,N1EL
  1014. MELVA2.VELCHE(II,III)=
  1015. & 1.D0/6.D0*MELVA6.VELCHE(II,III)
  1016. 280 CONTINUE
  1017. 270 CONTINUE
  1018. SEGSUP MELVA6
  1019. GOTO 290
  1020. ENDIF
  1021. IF (NOM5.EQ.NOMTT) THEN
  1022. SEGINI MELVA3
  1023. DO 300 II = 1,N1PTEL
  1024. DO 310 III = 1,N1EL
  1025. MELVA3.VELCHE(II,III)=
  1026. & 1.D0/6.D0*MELVA6.VELCHE(II,III)
  1027. 310 CONTINUE
  1028. 300 CONTINUE
  1029. SEGSUP MELVA6
  1030. GOTO 290
  1031. ENDIF
  1032. ELSEIF (INO2.NE.0) THEN
  1033. IF (NOM4.EQ.NOMTT) THEN
  1034. MELVA2=MCHAM2.IELVAL(INO2)
  1035. GOTO 290
  1036. ENDIF
  1037. IF ((IVAR.EQ.2).AND.(NOM5.EQ.NOMTT)) THEN
  1038. MELVA3=MCHAM2.IELVAL(INO2)
  1039. GOTO 290
  1040. ENDIF
  1041. ENDIF
  1042. ELSE
  1043. ITRO = 0
  1044. DO 320 INO = 1,NCO1
  1045. NOM2 = MCHAM2.NOMCHE(INO)
  1046. IF (IVAR.EQ.1.AND.NOM4.EQ.NOM2) THEN
  1047. MELVA2=MCHAM2.IELVAL(INO)
  1048. GOTO 290
  1049. ENDIF
  1050. IF (IVAR.EQ.2) THEN
  1051. IF (NOM4.EQ.NOM2) THEN
  1052. MELVA2=MCHAM2.IELVAL(INO)
  1053. ITRO = ITRO + 1
  1054. ENDIF
  1055. IF (NOM5.EQ.NOM2) THEN
  1056. MELVA3=MCHAM2.IELVAL(INO)
  1057. ITRO = ITRO + 1
  1058. ENDIF
  1059. IF (ITRO.EQ.2) GOTO 290
  1060. ENDIF
  1061. 320 CONTINUE
  1062. ENDIF
  1063. C
  1064. CALL ERREUR(665)
  1065. GOTO 9910
  1066. C
  1067. 290 CONTINUE
  1068.  
  1069. N1PTE1=MELVA2.VELCHE(/1)
  1070. N1E1 =MELVA2.VELCHE(/2)
  1071. IF (IVAR.EQ.2) THEN
  1072. N1PTE2=MELVA3.VELCHE(/1)
  1073. N1E2 =MELVA3.VELCHE(/2)
  1074. ENDIF
  1075. C On teste la taille du MCHAML_FLOTTANT
  1076. IF (N1E1.NE.NEL0.AND.N1E1.NE.1.AND.NEL0.NE.1) THEN
  1077. MOTERR(1:8)='VARINU '
  1078. CALL ERREUR(146)
  1079. GOTO 9910
  1080. ENDIF
  1081. IF (IVAR.EQ.2.AND.
  1082. & N1E2.NE.NEL0.AND.N1E2.NE.1.AND.NEL0.NE.1) THEN
  1083. MOTERR(1:8)='VARINU '
  1084. CALL ERREUR(146)
  1085. GOTO 9910
  1086. ENDIF
  1087. IF (N1PTE1.NE.1.AND.N1PTE1.NE.NBPGAU) THEN
  1088. MOTERR(1:8)='VARINU '
  1089. CALL ERREUR(146)
  1090. GOTO 9910
  1091. ENDIF
  1092. IF (IVAR.EQ.2.AND.
  1093. & N1PTE2.NE.1.AND.N1PTE2.NE.NBPGAU) THEN
  1094. MOTERR(1:8)='VARINU '
  1095. CALL ERREUR(146)
  1096. GOTO 9910
  1097. ENDIF
  1098. C
  1099. NUAVFL=NUAPOI(IA1)
  1100. NUAVIN=NUAPOI(IBBON)
  1101. NBC1 =NUAFLO(/1)
  1102. NBC2 =NUAINT(/1)
  1103. IF (IVAR.EQ.2) THEN
  1104. NUAVF1=NUAPOI(IA2)
  1105. NBC3=NUAVF1.NUAFLO(/1)
  1106. IF (NBC1.NE.NBC2.OR.NBC2.NE.NBC3) THEN
  1107. CALL ERREUR(625)
  1108. GOTO 9910
  1109. ENDIF
  1110. IF (NBC1.LE.1) THEN
  1111. INTERR(1)=MNUAGE
  1112. INTERR(2)=2
  1113. INTERR(3)=2
  1114. CALL ERREUR(628)
  1115. GOTO 9910
  1116. ENDIF
  1117. ELSE
  1118. IF (NBC1.NE.NBC2) THEN
  1119. CALL ERREUR(625)
  1120. GOTO 9910
  1121. ENDIF
  1122. IF (NBC1.LE.1) THEN
  1123. INTERR(1)=MNUAGE
  1124. INTERR(2)=2
  1125. INTERR(3)=2
  1126. CALL ERREUR(628)
  1127. GOTO 9910
  1128. ENDIF
  1129. ENDIF
  1130. C En cas de MCHAML de type caracteristiques on verifie
  1131. C la coherence entre les modules d'young et la pente
  1132. C des courbes de traction
  1133. IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') THEN
  1134. CALL VERINU(IPOI1,ISOUS,IYOUN,ICOMP)
  1135. IF (IERR.NE.0) THEN
  1136. GOTO 9910
  1137. ENDIF
  1138. ENDIF
  1139. C La valeur maxi. et mini. de l'objet flottant défini dans NUAGE
  1140. IF (IVAR.EQ.1) THEN
  1141. XMAX1=-1.D35
  1142. XMIN1= 1.D35
  1143. DO 330 IC=1,NBC1
  1144. IF (NUAFLO(IC).GT.XMAX1) THEN
  1145. XMAX1=NUAFLO(IC)
  1146. IMAX1=IC
  1147. ENDIF
  1148. IF (NUAFLO(IC).LT.XMIN1) THEN
  1149. XMIN1=NUAFLO(IC)
  1150. IMIN1=IC
  1151. ENDIF
  1152. 330 CONTINUE
  1153. ENDIF
  1154. IF (IVAR.EQ.2) THEN
  1155. XMAX1=-1.D35
  1156. XMIN1= 1.D35
  1157. XMAX3=-1.D35
  1158. XMIN3= 1.D35
  1159. DO 340 IC=1,NBC1
  1160. IF (NUAFLO(IC).GT.XMAX1) XMAX1=NUAFLO(IC)
  1161. IF (NUAFLO(IC).LT.XMIN1) XMIN1=NUAFLO(IC)
  1162. IF (NUAVF1.NUAFLO(IC).GT.XMAX3) XMAX3=NUAVF1.NUAFLO(IC)
  1163. IF (NUAVF1.NUAFLO(IC).LT.XMIN3) XMIN3=NUAVF1.NUAFLO(IC)
  1164. 340 CONTINUE
  1165. XZOB1 = 0.5D0*(XMIN1+XMAX1)
  1166. XZOB3 = 0.5D0*(XMIN3+XMAX3)
  1167. DO 350 IC=1,NBC1
  1168. TEST1 = (NUAFLO(IC) - XMIN1) / XZOB1
  1169. TEST3 = (NUAVF1.NUAFLO(IC) - XMIN3) / XZOB3
  1170. IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10)
  1171. & IMI1MI3=IC
  1172. TEST1 = (NUAFLO(IC) - XMIN1) / XZOB1
  1173. TEST3 = (NUAVF1.NUAFLO(IC) - XMAX3) / XZOB3
  1174. IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10)
  1175. & IMI1MA3=IC
  1176. TEST1 = (NUAFLO(IC) - XMAX1) / XZOB1
  1177. TEST3 = (NUAVF1.NUAFLO(IC) - XMIN3) / XZOB3
  1178. IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10)
  1179. & IMA1MI3=IC
  1180. TEST1 = (NUAFLO(IC) - XMAX1) / XZOB1
  1181. TEST3 = (NUAVF1.NUAFLO(IC) - XMAX3) / XZOB3
  1182. IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10)
  1183. & IMA1MA3=IC
  1184. 350 CONTINUE
  1185. C
  1186. C Test : nuage sous forme GRILLE
  1187. C
  1188. NFLO = NBC1
  1189. SEGINI IAMO2
  1190. C
  1191. NFLO = NBC1
  1192. SEGINI IAMO2
  1193. IFLO1 = 1
  1194. IFLO2(IFLO1) = 1
  1195. FLO1(IFLO1) = NUAFLO(1)
  1196. FLO2(IFLO1,IFLO2(IFLO1)) = NUAVF1.NUAFLO(1)
  1197. DO 360 IC1=2,NBC1
  1198. DO 370 IFL1=1,IFLO1
  1199. TEST1 = (NUAFLO(IC1) - FLO1(IFL1)) / XZOB1
  1200. IF (ABS(TEST1).LT.1.D-10) GOTO 380
  1201. 370 CONTINUE
  1202. IFLO1 = IFLO1 + 1
  1203. FLO1(IFLO1) = NUAFLO(IC1)
  1204. IFLO2(IFLO1) = 1
  1205. FLO2(IFLO1,IFLO2(IFLO1)) = NUAVF1.NUAFLO(IC1)
  1206. GOTO 360
  1207. 380 CONTINUE
  1208. DO 390 IFL2=1,IFLO2(IFL1)
  1209. TEST3 =
  1210. & (NUAVF1.NUAFLO(IC1) - FLO2(IFL1,IFL2)) / XZOB3
  1211. IF (ABS(TEST3).LT.1.D-10) THEN
  1212. SEGSUP IAMO2
  1213. INTERR(1)=MNUAGE
  1214. CALL ERREUR(940)
  1215. GOTO 9900
  1216. ENDIF
  1217. 390 CONTINUE
  1218. IFLO2(IFL1) = IFLO2(IFL1) + 1
  1219. FLO2(IFL1,IFLO2(IFL1)) = NUAVF1.NUAFLO(IC1)
  1220. 360 CONTINUE
  1221. C
  1222. DO 400 IFL1=2,IFLO1
  1223. IF (IFLO2(IFL1).NE.IFLO2(1)) THEN
  1224. SEGSUP IAMO2
  1225. INTERR(1)=MNUAGE
  1226. CALL ERREUR(941)
  1227. GOTO 9900
  1228. ENDIF
  1229. DO 410 IFL2=1,IFLO2(IFL1)
  1230. DO 420 IFL=1,IFLO2(1)
  1231. TEST3 = (FLO2(IFL1,IFL2) - FLO2(1,IFL)) / XZOB3
  1232. IF (ABS(TEST3).LT.1.D-10) GOTO 410
  1233. 420 CONTINUE
  1234. SEGSUP IAMO2
  1235. INTERR(1)=MNUAGE
  1236. CALL ERREUR(941)
  1237. GOTO 9900
  1238. 410 CONTINUE
  1239. 400 CONTINUE
  1240. C
  1241. SEGSUP IAMO2
  1242. ENDIF
  1243. C
  1244. KFLOT = .TRUE.
  1245. IF (.NOT.KREAL) THEN
  1246. NOMID=IPNOMC
  1247. NOTYPE=MOTYPE
  1248. SEGACT NOTYPE
  1249. DO 430 IOBL=1,NBROBL
  1250. IF (LESOBL(IOBL).EQ.NOMCO) THEN
  1251. TYPV=TYPE(IOBL)
  1252. IF (TYPV(1:6).NE.'REAL*8') KFLOT = .FALSE.
  1253. GOTO 440
  1254. ENDIF
  1255. 430 CONTINUE
  1256. DO 450 IFAC=1,NBRFAC
  1257. IF (LESFAC(IFAC).EQ.NOMCO) THEN
  1258. TYPV=TYPE(NBROBL+IFAC)
  1259. IF (TYPV(1:6).NE.'REAL*8') KFLOT = .FALSE.
  1260. GOTO 440
  1261. ENDIF
  1262. 450 CONTINUE
  1263. 440 CONTINUE
  1264. SEGDES NOTYPE
  1265. ENDIF
  1266. C
  1267. IF (IVAR.EQ.1) THEN
  1268. C
  1269. C Cas du nuage FLOTTANT-EVOLUTION
  1270. C
  1271. C La taille du nouvau MCHAML_EVOLUTION
  1272. N1PTEL = 0
  1273. N1EL = 0
  1274. N2EL = N1E1
  1275. IF (N1PTE1.EQ.1) THEN
  1276. N2PTEL=1
  1277. ELSE
  1278. N2PTEL=NBPGAU
  1279. ENDIF
  1280. SEGINI MELVAL
  1281. IELVAL(ICOMP)=MELVAL
  1282. C
  1283. DO 460 IEL=1,N2EL
  1284. DO 470 IGAU=1,N2PTEL
  1285. VA1=MELVA2.VELCHE(IGAU,IEL)
  1286. C Si la valeur VA1 est tombée pile à un flottant défini dans
  1287. C nuage, on prend la courbe correspondant au flottant.
  1288. DO 480 IN=1,NBC1-1
  1289. IF ((NUAFLO(IN+1)-NUAFLO(IN)).EQ.0.D0) THEN
  1290. XZOB=0.5D0*(XMIN1+XMAX1)
  1291. TEST1 = (VA1-NUAFLO(IN))/XZOB
  1292. ELSE
  1293. TEST1 = (VA1-NUAFLO(IN))/
  1294. & (NUAFLO(IN+1)-NUAFLO(IN))
  1295. ENDIF
  1296. IF (ABS(TEST1).LT.1.D-10) THEN
  1297. IEV3=NUAINT(IN)
  1298. GOTO 490
  1299. ENDIF
  1300. 480 CONTINUE
  1301. C Si la valeur VA1 est supérieure au flottant maxi.,
  1302. C on prend la courbe correspondant au flottant maxi..
  1303. IF (VA1.GE.NUAFLO(IMAX1)) THEN
  1304. IEV3=NUAINT(IMAX1)
  1305. C Si la valeur VA1 est inférieure au flottant mini.,
  1306. C on prend la courbe correspondant au flottant mini..
  1307. ELSEIF (VA1.LE.NUAFLO(IMIN1)) THEN
  1308. IEV3=NUAINT(IMIN1)
  1309. ELSE
  1310. VMAX1=-1.D35
  1311. VMIN1= 1.D35
  1312. DO 500 IC=1,NBC1
  1313. IF (VA1.GT.NUAFLO(IC).AND.NUAFLO(IC).GT.VMAX1)
  1314. & THEN
  1315. VMAX1=NUAFLO(IC)
  1316. IGA=IC
  1317. ENDIF
  1318. IF (VA1.LT.NUAFLO(IC).AND.NUAFLO(IC).LT.VMIN1)
  1319. & THEN
  1320. VMIN1=NUAFLO(IC)
  1321. IDR=IC
  1322. ENDIF
  1323. 500 CONTINUE
  1324. XX1 =(NUAFLO(IDR)-VA1)/(NUAFLO(IDR)-NUAFLO(IGA))
  1325. XX2 =(VA1-NUAFLO(IGA))/(NUAFLO(IDR)-NUAFLO(IGA))
  1326. IEV1= NUAINT(IGA)
  1327. IEV2= NUAINT(IDR)
  1328. IF (IEV1.EQ.IEV2) THEN
  1329. IEV3=IEV1
  1330. ELSE
  1331. CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3)
  1332. IF (IEV3.EQ.0 .OR. IERR.NE.0) GOTO 9900
  1333.  
  1334. C En cas de MCHAML de type caracteristiques on modifie
  1335. C la courbe de traction issue de EVOLIN pour que la pente
  1336. C soit interpolée linéairement
  1337. IF(IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ')THEN
  1338. CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA,IDR,
  1339. & IEV1,IEV2,VA1,1,IEV4)
  1340. IF (IEV4.EQ.0 .OR. IERR.NE.0) GOTO 9900
  1341. IEV3=IEV4
  1342. ENDIF
  1343. ENDIF
  1344. ENDIF
  1345. 490 CONTINUE
  1346. IELCHE(IGAU,IEL)=IEV3
  1347. 470 CONTINUE
  1348. 460 CONTINUE
  1349.  
  1350. IF (KFLOT) THEN
  1351. NCO1 = MCHAM2.IELVAL(/1)
  1352. MEVOLL = IELCHE(1,1)
  1353. KEVOLL = IEVOLL(1)
  1354. NOM4 = NOMEVX(1:8)
  1355. NCO1 = MCHAM2.IELVAL(/1)
  1356. DO 510 INO = 1,NCO1
  1357. NOM2 = MCHAM2.NOMCHE(INO)
  1358. IF (NOM2.EQ.NOM4) GOTO 520
  1359. 510 CONTINUE
  1360. KFLOT=.FALSE.
  1361. 520 CONTINUE
  1362. ENDIF
  1363. C
  1364. IF (KFLOT) THEN
  1365. TYPCHE(ICOMP)='REAL*8 '
  1366. MELVA6=MELVAL
  1367. ICHAM2=MCHAM2
  1368. CALL VARIN2(ICHAM2,MELVA6,COQ,MELEME,SWORK,NOMCO,IMELE,
  1369. & MELGEO,MINTE,MINTE1,MELVAL,KERRE1)
  1370. SEGSUP MELVA6
  1371. ENDIF
  1372. C
  1373. IELVAL(ICOMP)=MELVAL
  1374. C
  1375. ENDIF
  1376. C
  1377. IF (IVAR.EQ.2) THEN
  1378. C
  1379. C Cas du nuage FLOTTANT-FLOTTANT-EVOLUTION
  1380. C
  1381. C La taille du nouvau MCHAML_EVOLUTION
  1382. N1PTEL = 0
  1383. N1EL = 0
  1384. N2EL = N1E1
  1385. IF (N1E1.EQ.1.AND.N1E2.EQ.1) THEN
  1386. N2EL=1
  1387. ELSE
  1388. N2EL=NEL0
  1389. ENDIF
  1390. IF (N1PTE1.EQ.1.AND.N1PTE2.EQ.1) THEN
  1391. N2PTEL=1
  1392. ELSE
  1393. N2PTEL=NBPGAU
  1394. ENDIF
  1395. SEGINI MELVAL
  1396. IELVAL(ICOMP)=MELVAL
  1397. C
  1398. DO 530 IEL=1,N2EL
  1399. DO 540 IGAU=1,N2PTEL
  1400. IEL1 = MIN(IEL,N1E1)
  1401. IGAU1 = MIN(IGAU,N1PTE1)
  1402. VA1=MELVA2.VELCHE(IGAU1,IEL1)
  1403. IEL2 = MIN(IEL,N1E2)
  1404. IGAU2 = MIN(IGAU,N1PTE2)
  1405. VA2=MELVA3.VELCHE(IGAU2,IEL2)
  1406. C Si les valeurs VA1 et VA2 sont tombées pile à un flottant défini dans
  1407. C nuage, on prend la courbe correspondant au flottant.
  1408. VMAX1=-1.D35
  1409. VMIN1=1.D35
  1410. VMAX2=-1.D35
  1411. VMIN2=1.D35
  1412. IDR1=0
  1413. IGA1=0
  1414. IDR2=0
  1415. IGA2=0
  1416. DO 550 IN=1,NBC1-1
  1417. IF ((NUAFLO(IN+1)-NUAFLO(IN)).EQ.0.D0) THEN
  1418. XZOB=0.5D0*(XMIN1+XMAX1)
  1419. TEST1 = (VA1-NUAFLO(IN))/XZOB
  1420. TMAX1 = (NUAFLO(IN)-NUAFLO(IMA1MA3))/XZOB
  1421. TMIN1 = (NUAFLO(IN)-NUAFLO(IMI1MI3))/XZOB
  1422. ELSE
  1423. TEST1 = (VA1-NUAFLO(IN))/
  1424. & (NUAFLO(IN+1)-NUAFLO(IN))
  1425. TMAX1 = (NUAFLO(IN)-NUAFLO(IMA1MA3))/
  1426. & (NUAFLO(IN+1)-NUAFLO(IN))
  1427. TMIN1 = (NUAFLO(IN)-NUAFLO(IMI1MI3))/
  1428. & (NUAFLO(IN+1)-NUAFLO(IN))
  1429. ENDIF
  1430. IF ((NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN)).EQ.0.D0)
  1431. & THEN
  1432. XZOB=0.5D0*(XMIN3+XMAX3)
  1433. TEST2 = (VA2-NUAVF1.NUAFLO(IN))/XZOB
  1434. TMAX2 =
  1435. & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMA1MA3))/XZOB
  1436. TMIN2 =
  1437. & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMI1MI3))/XZOB
  1438. ELSE
  1439. TEST2 = (VA2-NUAVF1.NUAFLO(IN))/
  1440. & (NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN))
  1441. TMAX2 =
  1442. & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMA1MA3))/
  1443. & (NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN))
  1444. TMIN2 =
  1445. & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMI1MI3))/
  1446. & (NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN))
  1447. ENDIF
  1448. IF
  1449. & (ABS(TEST1).LT.1.D-10.AND.ABS(TEST2).LT.1.D-10)
  1450. & THEN
  1451. IEV3=NUAINT(IN)
  1452. GOTO 560
  1453. ELSE
  1454. IF (ABS(TEST1).LT.1.D-10.OR.
  1455. & (VA1.GT.NUAFLO(IMA1MA3).AND.
  1456. & ABS(TMAX1).LT.1.D-10).OR.
  1457. & (VA1.LT.NUAFLO(IMI1MI3).AND.
  1458. & ABS(TMIN1).LT.1.D-10)) THEN
  1459. IF (IGA1.NE.-1) THEN
  1460. VMAX2=-1.D35
  1461. VMIN2=1.D35
  1462. ENDIF
  1463. IF (VA2.GT.NUAVF1.NUAFLO(IN).AND.
  1464. & NUAVF1.NUAFLO(IN).GE.VMAX2) THEN
  1465. VMAX2=NUAVF1.NUAFLO(IN)
  1466. IGA2=IN
  1467. IF (VA2.GT.NUAVF1.NUAFLO(IMA1MA3)) THEN
  1468. IDR2=IN
  1469. ENDIF
  1470. ENDIF
  1471. IF (VA2.LT.NUAVF1.NUAFLO(IN).AND.
  1472. & NUAVF1.NUAFLO(IN).LE.VMIN2) THEN
  1473. VMIN2=NUAVF1.NUAFLO(IN)
  1474. IDR2=IN
  1475. IF (VA2.LT.NUAVF1.NUAFLO(IMI1MI3)) THEN
  1476. IGA2=IN
  1477. ENDIF
  1478. ENDIF
  1479. IGA1=-1
  1480. IDR1=-1
  1481. GOTO 550
  1482. ELSE
  1483. IF (IGA1.EQ.-1)GOTO 550
  1484. IF (ABS(TEST2).LT.1.D-10.OR.
  1485. & (VA2.GT.NUAVF1.NUAFLO(IMA1MA3).AND.
  1486. & ABS(TMAX2).LT.1.D-10).OR.
  1487. & (VA2.LT.NUAVF1.NUAFLO(IMI1MI3).AND.
  1488. & ABS(TMIN2).LT.1.D-10)) THEN
  1489. IF (IGA2.NE.-1) THEN
  1490. VMAX1=-1.D35
  1491. VMIN1=1.D35
  1492. ENDIF
  1493. IF
  1494. & (VA1.GT.NUAFLO(IN).AND.NUAFLO(IN).GE.VMAX1)
  1495. & THEN
  1496. VMAX1=NUAFLO(IN)
  1497. IGA1=IN
  1498. IF (VA1.GT.NUAFLO(IMA1MA3)) THEN
  1499. IDR1=IN
  1500. ENDIF
  1501. ENDIF
  1502. IF
  1503. & (VA1.LT.NUAFLO(IN).AND.NUAFLO(IN).LE.VMIN1)
  1504. & THEN
  1505. VMIN1=NUAFLO(IN)
  1506. IDR1=IN
  1507. IF (VA1.LT.NUAFLO(IMI1MI3)) THEN
  1508. IGA1=IN
  1509. ENDIF
  1510. ENDIF
  1511. IGA2=-1
  1512. IDR2=-1
  1513. GOTO 550
  1514. ELSE
  1515. IF (IGA2.EQ.-1)GOTO 550
  1516. IF
  1517. & (VA1.GT.NUAFLO(IN).AND.NUAFLO(IN).GE.VMAX1)
  1518. & THEN
  1519. IF (VA2.GT.NUAVF1.NUAFLO(IN).AND.
  1520. & NUAVF1.NUAFLO(IN).GE.VMAX2) THEN
  1521. VMAX1=NUAFLO(IN)
  1522. VMAX2=NUAVF1.NUAFLO(IN)
  1523. IGA1=IN
  1524. ENDIF
  1525. IF (VA2.LT.NUAVF1.NUAFLO(IN).AND.
  1526. & NUAVF1.NUAFLO(IN).LE.VMIN2) THEN
  1527. VMAX1=NUAFLO(IN)
  1528. VMIN2=NUAVF1.NUAFLO(IN)
  1529. IGA2=IN
  1530. ENDIF
  1531. ENDIF
  1532. IF
  1533. & (VA1.LT.NUAFLO(IN).AND.NUAFLO(IN).LE.VMIN1)
  1534. & THEN
  1535. IF (VA2.LT.NUAVF1.NUAFLO(IN).AND.
  1536. & NUAVF1.NUAFLO(IN).LE.VMIN2) THEN
  1537. VMIN1=NUAFLO(IN)
  1538. VMIN2=NUAVF1.NUAFLO(IN)
  1539. IDR2=IN
  1540. ENDIF
  1541. IF (VA2.GT.NUAVF1.NUAFLO(IN).AND.
  1542. & NUAVF1.NUAFLO(IN).GE.VMAX2) THEN
  1543. VMIN1=NUAFLO(IN)
  1544. VMAX2=NUAVF1.NUAFLO(IN)
  1545. IDR1=IN
  1546. ENDIF
  1547. ENDIF
  1548. ENDIF
  1549. ENDIF
  1550. ENDIF
  1551. 550 CONTINUE
  1552. IF ((NUAFLO(NBC1)-NUAFLO(NBC1-1)).EQ.0.D0) THEN
  1553. XZOB=0.5D0*(XMIN1+XMAX1)
  1554. TEST1 = (VA1-NUAFLO(NBC1))/XZOB
  1555. TMAX1 = (NUAFLO(NBC1)-NUAFLO(IMA1MA3))/XZOB
  1556. TMIN1 = (NUAFLO(NBC1)-NUAFLO(IMI1MI3))/XZOB
  1557. ELSE
  1558. TEST1 = (VA1-NUAFLO(NBC1))/
  1559. & (NUAFLO(NBC1)-NUAFLO(NBC1-1))
  1560. TMAX1 = (NUAFLO(NBC1)-NUAFLO(IMA1MA3))/
  1561. & (NUAFLO(NBC1)-NUAFLO(NBC1-1))
  1562. TMIN1 = (NUAFLO(NBC1)-NUAFLO(IMI1MI3))/
  1563. & (NUAFLO(NBC1)-NUAFLO(NBC1-1))
  1564. ENDIF
  1565. IF
  1566. & ((NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1)).EQ.0.D0)
  1567. & THEN
  1568. XZOB=0.5D0*(XMIN3+XMAX3)
  1569. TEST2 = (VA2-NUAVF1.NUAFLO(NBC1))/XZOB
  1570. TMAX2 =
  1571. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMA1MA3))/XZOB
  1572. TMIN2 =
  1573. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMI1MI3))/XZOB
  1574. ELSE
  1575. TEST2 = (VA2-NUAVF1.NUAFLO(NBC1))/
  1576. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1))
  1577. TMAX2 =
  1578. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMA1MA3))/
  1579. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1))
  1580. TMIN2 =
  1581. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMI1MI3))/
  1582. & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1))
  1583. ENDIF
  1584. C
  1585. IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST2).LT.1.D-10)
  1586. & THEN
  1587. IEV3=NUAINT(NBC1)
  1588. GOTO 560
  1589. ELSE
  1590. IF (ABS(TEST1).LT.1.D-10.OR.
  1591. & (VA1.GT.NUAFLO(IMA1MA3).AND.
  1592. & ABS(TMAX1).LT.1.D-10).OR.
  1593. & (VA1.LT.NUAFLO(IMI1MI3).AND.
  1594. & ABS(TMIN1).LT.1.D-10)) THEN
  1595. IF (VA2.GT.NUAVF1.NUAFLO(NBC1).AND.
  1596. & NUAVF1.NUAFLO(NBC1).GE.VMAX2) THEN
  1597. VMAX2=NUAVF1.NUAFLO(NBC1)
  1598. IGA2=NBC1
  1599. IF (VA2.GT.NUAVF1.NUAFLO(IMA1MA3)) THEN
  1600. IDR2=NBC1
  1601. ENDIF
  1602. ENDIF
  1603. IF (VA2.LT.NUAVF1.NUAFLO(NBC1).AND.
  1604. & NUAVF1.NUAFLO(NBC1).LE.VMIN2) THEN
  1605. VMIN2=NUAVF1.NUAFLO(NBC1)
  1606. IDR2=NBC1
  1607. IF (VA2.LT.NUAVF1.NUAFLO(IMI1MI3)) THEN
  1608. IGA2=NBC1
  1609. ENDIF
  1610. ENDIF
  1611. IGA1=-1
  1612. IDR1=-1
  1613. GOTO 570
  1614. ELSE
  1615. IF (IGA1.EQ.-1)GOTO 570
  1616. IF (ABS(TEST2).LT.1.D-10.OR.
  1617. & (VA2.GT.NUAVF1.NUAFLO(IMA1MA3).AND.
  1618. & ABS(TMAX2).LT.1.D-10).OR.
  1619. & (VA2.LT.NUAVF1.NUAFLO(IMI1MI3).AND.
  1620. & ABS(TMIN2).LT.1.D-10)) THEN
  1621. IF
  1622. & (VA1.GT.NUAFLO(NBC1).AND.NUAFLO(NBC1).GE.VMAX1)
  1623. & THEN
  1624. VMAX1=NUAFLO(NBC1)
  1625. IGA1=NBC1
  1626. IF (VA1.GT.NUAFLO(IMA1MA3)) THEN
  1627. IDR1=NBC1
  1628. ENDIF
  1629. ENDIF
  1630. IF
  1631. & (VA1.LT.NUAFLO(NBC1).AND.NUAFLO(NBC1).LE.VMIN1)
  1632. & THEN
  1633. VMIN1=NUAFLO(NBC1)
  1634. IDR1=NBC1
  1635. IF (VA1.LT.NUAFLO(IMI1MI3)) THEN
  1636. IGA1=NBC1
  1637. ENDIF
  1638. ENDIF
  1639. IGA2=-1
  1640. IDR2=-1
  1641. GOTO 570
  1642. ELSE
  1643. IF (IGA1.EQ.-1.OR.IGA2.EQ.-1)GOTO 570
  1644. IF
  1645. & (VA1.GT.NUAFLO(NBC1).AND.NUAFLO(NBC1).GE.VMAX1)
  1646. & THEN
  1647. IF (VA2.GT.NUAVF1.NUAFLO(NBC1).AND.
  1648. & NUAVF1.NUAFLO(NBC1).GE.VMAX2) THEN
  1649. VMAX1=NUAFLO(NBC1)
  1650. VMAX2=NUAVF1.NUAFLO(NBC1)
  1651. IGA1=IN
  1652. ENDIF
  1653. IF (VA2.LT.NUAVF1.NUAFLO(NBC1).AND.
  1654. & NUAVF1.NUAFLO(NBC1).LE.VMIN2) THEN
  1655. VMAX1=NUAFLO(NBC1)
  1656. VMIN2=NUAVF1.NUAFLO(NBC1)
  1657. IGA2=IN
  1658. ENDIF
  1659. ENDIF
  1660. IF
  1661. & (VA1.LT.NUAFLO(NBC1).AND.NUAFLO(NBC1).LE.VMIN1)
  1662. & THEN
  1663. IF (VA2.LT.NUAVF1.NUAFLO(NBC1).AND.
  1664. & NUAVF1.NUAFLO(NBC1).LE.VMIN2) THEN
  1665. VMIN1=NUAFLO(NBC1)
  1666. VMIN2=NUAVF1.NUAFLO(NBC1)
  1667. IDR2=IN
  1668. ENDIF
  1669. IF (VA2.GT.NUAVF1.NUAFLO(NBC1).AND.
  1670. & NUAVF1.NUAFLO(NBC1).GE.VMAX2) THEN
  1671. VMIN1=NUAFLO(NBC1)
  1672. VMAX2=NUAVF1.NUAFLO(NBC1)
  1673. IDR1=IN
  1674. ENDIF
  1675. ENDIF
  1676. ENDIF
  1677. ENDIF
  1678. ENDIF
  1679. C Si les valeurs VA1 et VA2 sont supérieures au flottant maxi.,
  1680. C on prend la courbe correspondant aux flottants maxi.
  1681. 570 CONTINUE
  1682. IF (VA1.GE.NUAFLO(IMA1MA3).AND.
  1683. & VA2.GE.NUAVF1.NUAFLO(IMA1MA3)) THEN
  1684. IEV3=NUAINT(IMA1MA3)
  1685. GOTO 560
  1686. ENDIF
  1687. IF (VA1.LE.NUAFLO(IMI1MI3).AND.
  1688. & VA2.LE.NUAVF1.NUAFLO(IMI1MI3)) THEN
  1689. IEV3=NUAINT(IMI1MI3)
  1690. GOTO 560
  1691. ENDIF
  1692. IF (VA1.LE.NUAFLO(IMI1MA3).AND.
  1693. & VA2.GE.NUAVF1.NUAFLO(IMI1MA3)) THEN
  1694. IEV3=NUAINT(IMI1MA3)
  1695. GOTO 560
  1696. ENDIF
  1697. IF (VA1.GE.NUAFLO(IMA1MI3).AND.
  1698. & VA2.LE.NUAVF1.NUAFLO(IMA1MI3)) THEN
  1699. IEV3=NUAINT(IMA1MI3)
  1700. GOTO 560
  1701. ENDIF
  1702. C Si seule la valeur VA1 est tombée pile à un flottant défini dans
  1703. C nuage ou est supérieure à la valeur maxi, on interpole sur VA2
  1704. IF (IGA1.EQ.-1) THEN
  1705. XX1=(NUAVF1.NUAFLO(IDR2)-VA2)/
  1706. & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IGA2))
  1707. XX2=(VA2-NUAVF1.NUAFLO(IGA2))/
  1708. & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IGA2))
  1709. IEV1=NUAINT(IGA2)
  1710. IEV2=NUAINT(IDR2)
  1711. IF (IEV1.EQ.IEV2) THEN
  1712. IEV3=IEV1
  1713. ELSE
  1714. CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3)
  1715. IF (IEV3.EQ.0.OR.IERR.NE.0) THEN
  1716. GOTO 9900
  1717. ENDIF
  1718. C En cas de MCHAML de type caracteristiques on modifie
  1719. C la courbe de traction issue de EVOLIN pour que la pente
  1720. C soit interpolée linéairement
  1721. IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ')
  1722. & THEN
  1723. CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA2,IDR2,
  1724. & IEV1,IEV2,VA2,2,IEV4)
  1725. IF (IEV4.EQ.0.OR.IERR.NE.0) THEN
  1726. GOTO 9900
  1727. ENDIF
  1728. IEV3=IEV4
  1729. ENDIF
  1730. ENDIF
  1731. GOTO 560
  1732. ENDIF
  1733. C Si seule la valeur VA2 est tombée pile à un flottant défini dans
  1734. C nuage ou est supérieure à la valeur maxi, on interpole sur VA1
  1735. IF (IGA2.EQ.-1) THEN
  1736. XX1=(NUAFLO(IDR1)-VA1)/(NUAFLO(IDR1)-NUAFLO(IGA1))
  1737. XX2=(VA1-NUAFLO(IGA1))/(NUAFLO(IDR1)-NUAFLO(IGA1))
  1738. IEV1=NUAINT(IGA1)
  1739. IEV2=NUAINT(IDR1)
  1740. IF (IEV1.EQ.IEV2) THEN
  1741. IEV3=IEV1
  1742. ELSE
  1743. CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3)
  1744. IF (IEV3.EQ.0.OR.IERR.NE.0) THEN
  1745. GOTO 9900
  1746. ENDIF
  1747. C En cas de MCHAML de type caracteristiques on modifie
  1748. C la courbe de traction issue de EVOLIN pour que la pente
  1749. C soit interpolée linéairement
  1750. IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ')
  1751. & THEN
  1752. CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA1,IDR1,
  1753. & IEV1,IEV2,VA1,1,IEV4)
  1754. IF (IEV4.EQ.0.OR.IERR.NE.0) THEN
  1755. GOTO 9900
  1756. ENDIF
  1757. IEV3=IEV4
  1758. ENDIF
  1759. ENDIF
  1760. GOTO 560
  1761. ENDIF
  1762. C Cas général : on interpole sur VA1 PUIS VA2
  1763. C -- > sur VA1
  1764. XX1=(NUAFLO(IDR1)-VA1)/(NUAFLO(IDR1)-NUAFLO(IGA1))
  1765. XX2=(VA1-NUAFLO(IGA1))/(NUAFLO(IDR1)-NUAFLO(IGA1))
  1766. IEV1=NUAINT(IGA1)
  1767. IEV2=NUAINT(IDR1)
  1768. IF (IEV1.EQ.IEV2) THEN
  1769. IEV3=IEV1
  1770. ELSE
  1771. CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3)
  1772. IF (IEV3.EQ.0.OR.IERR.NE.0) THEN
  1773. GOTO 9900
  1774. ENDIF
  1775. C En cas de MCHAML de type caracteristiques on modifie
  1776. C la courbe de traction issue de EVOLIN pour que la pente
  1777. C soit interpolée linéairement
  1778. IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ')
  1779. & THEN
  1780. CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA1,IDR1,
  1781. & IEV1,IEV2,VA1,1,IEV4)
  1782. IF (IEV4.EQ.0.OR.IERR.NE.0) THEN
  1783. GOTO 9900
  1784. ENDIF
  1785. IEV3=IEV4
  1786. ENDIF
  1787. ENDIF
  1788. XX1=(NUAFLO(IDR2)-VA1)/(NUAFLO(IDR2)-NUAFLO(IGA2))
  1789. XX2=(VA1-NUAFLO(IGA2))/(NUAFLO(IDR2)-NUAFLO(IGA2))
  1790. IEV1=NUAINT(IGA2)
  1791. IEV2=NUAINT(IDR2)
  1792. IF (IEV1.EQ.IEV2) THEN
  1793. IEV4=IEV1
  1794. ELSE
  1795. CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV4)
  1796. IF (IEV4.EQ.0.OR.IERR.NE.0) THEN
  1797. GOTO 9900
  1798. ENDIF
  1799. C En cas de MCHAML de type caracteristiques on modifie
  1800. C la courbe de traction issue de EVOLIN pour que la pente
  1801. C soit interpolée linéairement
  1802. IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ')
  1803. & THEN
  1804. CALL MODICO(IPOI1,IEV4,ISOUS,ICOMP,IGA2,IDR2,
  1805. & IEV1,IEV2,VA1,1,IEV5)
  1806. IF (IEV5.EQ.0.OR.IERR.NE.0) THEN
  1807. GOTO 9900
  1808. ENDIF
  1809. IEV4=IEV5
  1810. ENDIF
  1811. ENDIF
  1812. C
  1813. C -- > sur VA2
  1814. XX1=(NUAVF1.NUAFLO(IDR2)-VA2)/
  1815. & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IDR1))
  1816. XX2=(VA2-NUAVF1.NUAFLO(IDR1))/
  1817. & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IDR1))
  1818. CALL EVOLIN(IEV3,XX1,IEV4,XX2,IEV5)
  1819. IF (IEV5.EQ.0.OR.IERR.NE.0) THEN
  1820. GOTO 9900
  1821. ENDIF
  1822. C En cas de MCHAML de type caracteristiques on modifie
  1823. C la courbe de traction issue de EVOLIN pour que la pente
  1824. C soit interpolée linéairement
  1825. IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') THEN
  1826. CALL MODICO(IPOI1,IEV5,ISOUS,ICOMP,IDR1,IDR2,IEV3,
  1827. & IEV4,VA2,2,IEV6)
  1828. IF (IEV6.EQ.0.OR.IERR.NE.0) THEN
  1829. GOTO 9900
  1830. ENDIF
  1831. IEV5=IEV6
  1832. ENDIF
  1833. IEV3=IEV5
  1834. C
  1835. 560 CONTINUE
  1836. IELCHE(IGAU,IEL)=IEV3
  1837. 540 CONTINUE
  1838. 530 CONTINUE
  1839. C
  1840. IF (KFLOT) THEN
  1841. NCO1 = MCHAM2.IELVAL(/1)
  1842. MEVOLL = IELCHE(1,1)
  1843. KEVOLL = IEVOLL(1)
  1844. NOM4 = NOMEVX(1:8)
  1845. NCO1 = MCHAM2.IELVAL(/1)
  1846. DO 580 INO = 1,NCO1
  1847. NOM2 = MCHAM2.NOMCHE(INO)
  1848. IF (NOM2.EQ.NOM4) GO TO 590
  1849. 580 CONTINUE
  1850. KFLOT=.FALSE.
  1851. 590 CONTINUE
  1852. ENDIF
  1853. C
  1854. IF (KFLOT) THEN
  1855. TYPCHE(ICOMP)='REAL*8 '
  1856. MELVA6=MELVAL
  1857. ICHAM2=MCHAM2
  1858. CALL VARIN2(ICHAM2,MELVA6,COQ,MELEME,SWORK,NOMCO,IMELE,
  1859. & MELGEO,MINTE,MINTE1,MELVAL,KERRE1)
  1860. SEGSUP MELVA6
  1861. ENDIF
  1862. C
  1863. IELVAL(ICOMP)=MELVAL
  1864. C
  1865. ENDIF
  1866. C
  1867. C---------------------------------------------------------
  1868. C Composante de type LISTMOTS
  1869. C (evaluation externe)
  1870. C---------------------------------------------------------
  1871. C
  1872. ELSE IF (CHA1(9:16).EQ.'LISTMOTS') THEN
  1873. *jk
  1874. if (FORMOD(1).EQ.'LIAISON') THEN
  1875. TYPCHE(ICOMP)=CHA1
  1876. N1PTEL=0
  1877. N1EL =0
  1878. N2PTEL=1
  1879. N2EL =1
  1880. SEGINI MELVAL
  1881. IELVAL(ICOMP)=MELVAL
  1882. IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1)
  1883. else
  1884. C
  1885. C Le LISTMOTS donne les parametres de la composante, en
  1886. C fonction desquels doit se faire l'evaluation externe.
  1887. C
  1888. C HYPOTHESE de CHAMP UNIFORME : la composante a les memes
  1889. C parametres en tout point d'integration de tout element
  1890. C de la sous-zone.
  1891. C Cette hypothese est necessaire car une composante ne peut
  1892. C etre associee qu'a une seule fonction externe.
  1893. C
  1894. N2PTE1=MELVA1.IELCHE(/1)
  1895. N2EL1=MELVA1.IELCHE(/2)
  1896. IF (N2PTE1.NE.1.AND.N2EL1.NE.1) THEN
  1897. MOTERR(1:8)=NOMCO
  1898. CALL ERREUR(953)
  1899. GOTO 9910
  1900. ENDIF
  1901. IVALIS(ICOMP) = 1
  1902. *
  1903. IF (JESIMU.EQ.0) THEN
  1904. C
  1905. C Acces au MCHAML des parametres sur la sous-zone
  1906. C
  1907. MCHEL2=IPOI3
  1908. IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN
  1909. CALL ERREUR(553)
  1910. GOTO 9910
  1911. ENDIF
  1912.  
  1913. IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR.
  1914. & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN
  1915.  
  1916. do is = 1,mchel2.imache(/1)
  1917. if (imamod.eq.mchel2.imache(is).and.
  1918. & conmod.eq.mchel2.conche(is)) then
  1919. MCHAM2 = mchel2.ICHAML(is)
  1920. goto 449
  1921. endif
  1922. enddo
  1923.  
  1924. CALL ERREUR(472)
  1925. GOTO 9910
  1926. ENDIF
  1927.  
  1928. MCHAM2=MCHEL2.ICHAML(ISOUS)
  1929. *
  1930. 449 CONTINUE
  1931.  
  1932. NCMP2=MCHAM2.NOMCHE(/2)
  1933. C
  1934. C Verification de la presence des parametres necessaires
  1935. C Verification que ces parametres sont du type REAL*8
  1936. C Releve des pointeurs vers les MELVAL correspondants
  1937. C Determination de la representation du champ de sortie
  1938. C
  1939. NOMCO4=NOMCO(1:4)
  1940. C
  1941. MLMOT1=MELVA1.IELCHE(1,1)
  1942. NPARA=MLMOT1.MOTS(/2)
  1943. *
  1944. IF (MLMOT1.MOTS(1)(1:4).EQ.NOMSIM) THEN
  1945. JESIMU=1
  1946. NPARA=NPARA-1
  1947. ENDIF
  1948. *
  1949. SEGINI,WRKEXT
  1950. C
  1951. N1PTEL=1
  1952. N1EL=1
  1953. C
  1954. DO 600 IPARA=1,NPARA
  1955. C
  1956. JPARA=IPARA+JESIMU
  1957.  
  1958. ITROUV=0
  1959. DO 601 ICMP2=1,NCMP2
  1960. IF (MCHAM2.NOMCHE(ICMP2)(1:4).EQ.
  1961. & MLMOT1.MOTS(JPARA)(1:4)) THEN
  1962. ITROUV = 1
  1963. GOTO 602
  1964. ENDIF
  1965. 601 CONTINUE
  1966. IF (ITROUV.EQ.0) THEN
  1967. MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4)
  1968. MOTERR(5:8)=NOMCO4
  1969. CALL ERREUR(954)
  1970. GOTO 9910
  1971. ENDIF
  1972. C
  1973. 602 CONTINUE
  1974. IF (MCHAM2.TYPCHE(ICMP2)(1:8).NE.'REAL*8 ') THEN
  1975. MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4)
  1976. MOTERR(5:8)=NOMCO4
  1977. CALL ERREUR(955)
  1978. GOTO 9910
  1979. ENDIF
  1980. C
  1981. NOMPAR(IPARA)=MLMOT1.MOTS(JPARA)(1:4)
  1982. IVAPAR(IPARA)=MCHAM2.IELVAL(ICMP2)
  1983. C
  1984. C N.B. Toutes les composantes du MCHAML de parametres
  1985. C s'appuient sur la meme famille de points de Gauss (cf.
  1986. C changement de support effectue en debut de traitement).
  1987. C Toutefois la representation peut etre differente d'un
  1988. C parametre a l'autre : uniforme, constante par element
  1989. C ou complete. La representation la plus fine sur tous
  1990. C les parametres impose celle de la variable de sortie.
  1991. C
  1992. MELVA2=IVAPAR(IPARA)
  1993. N1PTE2=MELVA2.VELCHE(/1)
  1994. N1EL2=MELVA2.VELCHE(/2)
  1995. IF (N1EL2.GT.1) THEN
  1996. IF (N1EL.EQ.1) THEN
  1997. N1EL=N1EL2
  1998. ELSE IF (N1EL2.NE.N1EL) THEN
  1999. MOTERR(1:8)='VARINU '
  2000. CALL ERREUR(146)
  2001. GOTO 9910
  2002. ENDIF
  2003. ENDIF
  2004. IF (N1PTE2.GT.1) THEN
  2005. IF (N1PTEL.EQ.1) THEN
  2006. N1PTEL=N1PTE2
  2007. ELSE IF (N1PTE2.NE.N1PTEL) THEN
  2008. MOTERR(1:8)='VARINU '
  2009. CALL ERREUR(146)
  2010. GOTO 9910
  2011. ENDIF
  2012. ENDIF
  2013. C
  2014. 600 CONTINUE
  2015. C
  2016. NPMAX = N1PTEL
  2017. NEMAX = N1EL
  2018. C
  2019. IF (JESIMU.EQ.0) THEN
  2020.  
  2021. N1PAUX=N1PTEL
  2022. C
  2023. C Pour les COQ4, le nb de pts de GAUSS vaut 5, mais on
  2024. C ne prend que les 4 premiers (le 5eme sert uniquement
  2025. C au cisaillement)
  2026. IF (IMELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  2027. C
  2028. C Premier appel au module externe COMPUT pour verifications
  2029. C
  2030. IVERI=1
  2031. IERUT=0
  2032. CALL COMPUT(IVERI,NOMCO4,NOMPAR,VALPAR,NPARA,
  2033. & VALCMP,IERUT)
  2034. IF (IERUT.NE.0) THEN
  2035. INTERR(1)=IERUT
  2036. CALL ERREUR(957)
  2037. GOTO 9910
  2038. ENDIF
  2039. C
  2040. C Initialisation du MELVAL de sortie
  2041. C
  2042. TYPCHE(ICOMP)='REAL*8 '
  2043. N2PTEL=0
  2044. N2EL=0
  2045. SEGINI MELVAL
  2046. IELVAL(ICOMP)=MELVAL
  2047. C
  2048. C Evaluation externe de la composante
  2049. C
  2050. IVERI=0
  2051. CC
  2052. DO 620 IEL=1,N1EL
  2053. DO 621 IGAU=1,N1PAUX
  2054. DO 622 IPARA=1,NPARA
  2055. MELVA2=IVAPAR(IPARA)
  2056. IBGAU=MIN(IGAU,MELVA2.VELCHE(/1))
  2057. IELGA=MIN(IEL,MELVA2.VELCHE(/2))
  2058. VALPAR(IPARA)=MELVA2.VELCHE(IBGAU,IELGA)
  2059. 622 CONTINUE
  2060. IERUT=0
  2061. CALL COMPUT(IVERI,NOMCO4,NOMPAR,VALPAR,NPARA,
  2062. & VELCHE(IGAU,IEL),IERUT)
  2063. IF (IERUT.NE.0) THEN
  2064. INTERR(1)=IERUT
  2065. CALL ERREUR(957)
  2066. GOTO 9900
  2067. ENDIF
  2068. 621 CONTINUE
  2069. 620 CONTINUE
  2070. C
  2071. SEGSUP,WRKEXT
  2072. C
  2073. ENDIF
  2074. C
  2075. ENDIF
  2076. endif
  2077. C
  2078. C---------------------------------------------------------
  2079. C Composante de type TABLE
  2080. C (evaluation externe avec dlopen)
  2081. C---------------------------------------------------------
  2082. C
  2083. ELSE IF (CHA1(9:16).EQ.'TABLE') THEN
  2084. *jk
  2085. if (FORMOD(1).EQ.'LIAISON') THEN
  2086. TYPCHE(ICOMP)=CHA1
  2087. N1PTEL=0
  2088. N1EL =0
  2089. N2PTEL=1
  2090. N2EL =1
  2091. SEGINI MELVAL
  2092. IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1)
  2093. IELVAL(ICOMP)=MELVAL
  2094. else
  2095. C
  2096. C La TABLE donne le nom de la loi et les parametres
  2097. C de la composante, en fonction desquels doit se faire
  2098. C l'evaluation externe.
  2099. C
  2100. N2PTE1=MELVA1.IELCHE(/1)
  2101. N2EL1=MELVA1.IELCHE(/2)
  2102. IF (N2PTE1.NE.1.AND.N2EL1.NE.1) THEN
  2103. MOTERR(1:8)=NOMCO
  2104. CALL ERREUR(953)
  2105. GOTO 9910
  2106. ENDIF
  2107. IVALIS(ICOMP) = 1
  2108. C
  2109. C Acces au MCHAML des parametres sur la sous-zone
  2110. C
  2111. MCHEL2=IPOI3
  2112.  
  2113. IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN
  2114. CALL ERREUR(553)
  2115. GOTO 9910
  2116. ENDIF
  2117.  
  2118. MCHAM2=MCHEL2.ICHAML(ISOUS)
  2119. IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR.
  2120. & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN
  2121. do is = 1,mchel2.imache(/1)
  2122. if (imamod.eq.mchel2.imache(is).and.
  2123. & conmod.eq.mchel2.conche(is)) then
  2124. MCHAM2 = mchel2.ICHAML(is)
  2125. goto 649
  2126. endif
  2127. enddo
  2128.  
  2129. CALL ERREUR(472)
  2130. GOTO 9910
  2131. ENDIF
  2132. *
  2133. 649 CONTINUE
  2134. NCMP2=MCHAM2.NOMCHE(/2)
  2135. C
  2136. C Verification de la presence des parametres necessaires
  2137. C Verification que ces parametres sont du type REAL*8
  2138. C Releve des pointeurs vers les MELVAL correspondants
  2139. C Determination de la representation du champ de sortie
  2140. C
  2141. NOMCO4=NOMCO(1:4)
  2142.  
  2143. C Vérification de la table
  2144. MTAB1 = MELVA1.IELCHE(1,1)
  2145. SEGACT,MTAB1
  2146.  
  2147. ITROUV = 0
  2148. ITROU1 = 0
  2149. ITROU2 = 0
  2150. C initialisation des indices
  2151. lacomm = ' '
  2152. LMEPRO = 0
  2153. LMELIB = ' '
  2154. LMELGB = 0
  2155. LMEFCT = ' '
  2156. LMELGT = 0
  2157. LMEPTR = 0
  2158. MLMOT1 = 0
  2159.  
  2160. C Recherche sur les noms
  2161. C Vérification des types des indices correspondants
  2162. if (NBESC.NE.0) SEGACT,IPILOC
  2163. IDEBCH=1
  2164. IFINCH=1
  2165.  
  2166. C Voir si ces tests ne pourraient pas etre faits qu'une fois (dans matcar ?)
  2167. DO 630 IN = 1, MTAB1.MLOTAB
  2168. IF (MTAB1.MTABTI(IN).NE.'MOT') GOTO 630
  2169. IP = MTAB1.MTABII(IN)
  2170. IDEBCH = IPCHAR(IP)
  2171. IFINCH = IPCHAR(IP+1)-1
  2172. MOTEMP = ICHARA(IDEBCH:IFINCH)
  2173. C Liste des parametres de la loi
  2174. IF ((MOTEMP.EQ.'PARA_LOI') .OR.
  2175. & (MOTEMP.EQ.'VARIABLES')) THEN
  2176. IF (MTAB1.MTABTV(IN).NE.'LISTMOTS') GOTO 631
  2177. MLMOT1 = MTAB1.MTABIV(IN)
  2178. C Nom de la loi/fonction a utiliser dans la librairie
  2179. ELSE IF ((MOTEMP.EQ.'FCT_LOI') .OR.
  2180. & (MOTEMP.EQ.'MODELE')) THEN
  2181. IF (MTAB1.MTABTV(IN).NE.'MOT') GOTO 631
  2182. IP = MTAB1.MTABIV(IN)
  2183. IDEBCH = IPCHAR(IP)
  2184. IFINCH = IPCHAR(IP+1)-1
  2185. LMELGT = IFINCH-IDEBCH+1
  2186. IF (LMELGT.LE.0 .OR. LMELGT.GT.72) THEN
  2187. INTERR(1) = LMELGT
  2188. MOTERR = ICHARA(IDEBCH:IFINCH)
  2189. CALL ERREUR(-2)
  2190. CALL ERREUR(36)
  2191. RETURN
  2192. ENDIF
  2193. LMEFCT = ICHARA(IDEBCH:IFINCH)
  2194. ITROU1 = 1
  2195. C Nom de la librairie ou se trouve la loi materiau
  2196. ELSE IF ((MOTEMP.EQ.'LIB_LOI') .OR.
  2197. & (MOTEMP.EQ.'LIBRAIRIE')) THEN
  2198. IF (MTAB1.MTABTV(IN).NE.'MOT') GOTO 631
  2199. IP = MTAB1.MTABIV(IN)
  2200. IDEBCH = IPCHAR(IP)
  2201. IFINCH = IPCHAR(IP+1)-1
  2202. LMELGB = IFINCH-IDEBCH+1
  2203. IF (LMELGB.GT.510) THEN
  2204. INTERR(1) = LMELGB
  2205. IFINCH =MAX(IDEBCH,IFINCH)
  2206. MOTERR =ICHARA(IDEBCH:IFINCH)
  2207. CALL ERREUR(-2)
  2208. CALL ERREUR(36)
  2209. RETURN
  2210. ENDIF
  2211. LMELIB = ICHARA(IDEBCH:IFINCH)
  2212. ITROU1 = 1
  2213. C Nom du programme externe
  2214. ELSE IF (MOTEMP.EQ.'PROGRAMME') THEN
  2215. IF (MTAB1.MTABTV(IN).NE.'MOT') GOTO 631
  2216. IP = MTAB1.MTABIV(IN)
  2217. IDEBCH = IPCHAR(IP)
  2218. IFINCH=IPCHAR(IP+1)-1
  2219. LMEPRO = IFINCH-IDEBCH+1
  2220. IF (LMEPRO.LE.0 .OR. LMEPRO.GT.510) THEN
  2221. INTERR(1) = LMEPRO
  2222. MOTERR = ICHARA(IDEBCH:IFINCH)
  2223. CALL ERREUR(-2)
  2224. CALL ERREUR(36)
  2225. RETURN
  2226. ENDIF
  2227. lacomm = ICHARA(IDEBCH:IFINCH)
  2228. ITROU2 = 1
  2229. ENDIF
  2230. 630 CONTINUE
  2231.  
  2232. C Dernieres verifications de la table
  2233. IF ((ITROU1.EQ.0).AND.(ITROU2.EQ.0)) THEN
  2234. write(ioimp,*) 'ERROR : PROGRAMME et LIB_LOI/FCT_LOI ?'
  2235. GOTO 631
  2236. ENDIF
  2237. IF ((ITROU1.NE.0).AND.(ITROU2.NE.0)) THEN
  2238. write(ioimp,*) 'ERROR : PROGRAMME ou LIB_LOI/FCT_LOI ??'
  2239. GOTO 631
  2240. ENDIF
  2241. IF (MLMOT1.EQ.0) THEN
  2242. write(ioimp,*) 'ERROR : PARA_LOI ?'
  2243. GOTO 631
  2244. ENDIF
  2245. SEGACT,MLMOT1
  2246. NPARA = MLMOT1.MOTS(/2)
  2247. IF (ITROU1.NE.0) THEN
  2248. IF (LMELGB.EQ.0 .OR. LMELGT.EQ.0) THEN
  2249. write(ioimp,*) 'ERROR : manque LIB_LOI ou FCT_LOI ? '
  2250. GOTO 631
  2251. ENDIF
  2252. LMELIB = LMELIB(1:LMELGB)//CHAR(0)
  2253. LMEFCT = LMEFCT(1:LMELGT)//CHAR(0)
  2254. CALL PTRLOI(LMELIB,LMELGB,LMEFCT,LMELGT,NPARA,LMEPTR)
  2255. IF (LMEPTR.LE.0) THEN
  2256. WRITE(ioimp,*) 'ERROR : Option LIB_LOI'
  2257. CALL ERREUR(21)
  2258. GOTO 631
  2259. ENDIF
  2260. ENDIF
  2261. C Verification de la table réussie
  2262. ITROUV = 1
  2263.  
  2264. 631 CONTINUE
  2265. if (NBESC.NE.0) SEGDES,IPILOC
  2266. SEGDES,MTAB1
  2267.  
  2268. C Erreur à la lecture de la table
  2269. IF (ITROUV.EQ.0) THEN
  2270. INTERR(1)=-3
  2271. CALL ERREUR(957)
  2272. GOTO 9910
  2273. ENDIF
  2274.  
  2275. C Vérification de la liste de paramètres
  2276.  
  2277. SEGINI,WRKEXT
  2278. C
  2279. N1PTEL=1
  2280. N1EL=1
  2281. C
  2282. DO 650 IPARA=1,NPARA
  2283. C
  2284. JPARA=IPARA+JESIMU
  2285. DO 651 ICMP2 = 1, NCMP2
  2286. IF (MCHAM2.NOMCHE(ICMP2)(1:4).EQ.
  2287. & MLMOT1.MOTS(JPARA)(1:4)) GOTO 652
  2288. 651 CONTINUE
  2289. C
  2290. MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4)
  2291. MOTERR(5:8)=NOMCO4
  2292. CALL ERREUR(954)
  2293. GOTO 9910
  2294. C
  2295. 652 CONTINUE
  2296. IF (MCHAM2.TYPCHE(ICMP2)(1:8).NE.'REAL*8 ') THEN
  2297. MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4)
  2298. MOTERR(5:8)=NOMCO4
  2299. CALL ERREUR(955)
  2300. GOTO 9910
  2301. ENDIF
  2302. C
  2303. NOMPAR(IPARA)=MLMOT1.MOTS(JPARA)(1:4)
  2304. IVAPAR(IPARA)=MCHAM2.IELVAL(ICMP2)
  2305. C
  2306. C N.B. Toutes les composantes du MCHAML de parametres
  2307. C s'appuient sur la meme famille de points de Gauss (cf.
  2308. C changement de support effectue en debut de traitement).
  2309. C Toutefois la representation peut etre differente d'un
  2310. C parametre a l'autre : uniforme, constante par element
  2311. C ou complete. La representation la plus fine sur tous
  2312. C les parametres impose celle de la variable de sortie.
  2313. C
  2314. MELVA2=IVAPAR(IPARA)
  2315. N1PTE2=MELVA2.VELCHE(/1)
  2316. N1EL2=MELVA2.VELCHE(/2)
  2317. IF (N1EL2.GT.1) THEN
  2318. IF (N1EL.EQ.1) THEN
  2319. N1EL=N1EL2
  2320. ELSE IF (N1EL2.NE.N1EL) THEN
  2321. MOTERR(1:8)='VARINU '
  2322. CALL ERREUR(146)
  2323. GOTO 9910
  2324. ENDIF
  2325. ENDIF
  2326. IF (N1PTE2.GT.1) THEN
  2327. IF (N1PTEL.EQ.1) THEN
  2328. N1PTEL=N1PTE2
  2329. ELSE IF (N1PTE2.NE.N1PTEL) THEN
  2330. MOTERR(1:8)='VARINU '
  2331. CALL ERREUR(146)
  2332. GOTO 9910
  2333. ENDIF
  2334. ENDIF
  2335. C
  2336. 650 CONTINUE
  2337. C
  2338. NPMAX = N1PTEL
  2339. NEMAX = N1EL
  2340. C
  2341. N1PAUX=N1PTEL
  2342. C
  2343. C Pour les COQ4, le nb de pts de GAUSS vaut 5, mais on
  2344. C ne prend que les 4 premiers (le 5eme sert uniquement
  2345. C au cisaillement)
  2346. IF (IMELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  2347. C
  2348. C Ouverture de la loi et vérification du nombre de paramètres
  2349. C
  2350. C Initialisation du MELVAL de sortie
  2351. C
  2352. TYPCHE(ICOMP)='REAL*8 '
  2353. N2PTEL=0
  2354. N2EL=0
  2355. SEGINI MELVAL
  2356. IELVAL(ICOMP)=MELVAL
  2357. C
  2358. IF (ITROU2.EQ.1) THEN
  2359. C Appel par programme externe
  2360. ith=0
  2361. ith=oothrd
  2362. moterr=lacomm(1:lmepro)
  2363. CALL lance(lacomm(1:lmepro)//char(0),ith)
  2364. DO 1670 IPARA=1,NPARA
  2365. MELVA2=IVAPAR(IPARA)
  2366. I_CHAMP=1
  2367. CALL becrdon(MELVA2.VELCHE,ith,IPARA,NPARA,
  2368. & I_CHAMP,N1EL,N1PAUX)
  2369. 1670 CONTINUE
  2370. CALL blires(VELCHE,iend,istat,ith)
  2371. *
  2372. ELSE IF (ITROU1.EQ.1) THEN
  2373. C appel par librairie
  2374. DO 670 IEL=1,N1EL
  2375. DO 671 IGAU=1,N1PAUX
  2376. DO 672 IPARA=1,NPARA
  2377. MELVA2=IVAPAR(IPARA)
  2378. IBGAU=MIN(IGAU,MELVA2.VELCHE(/1))
  2379. IELGA=MIN(IEL,MELVA2.VELCHE(/2))
  2380. VALPAR(IPARA)=MELVA2.VELCHE(IBGAU,IELGA)
  2381. 672 CONTINUE
  2382. IERUT=0
  2383. CALL LOIEXT(LMEPTR,VALPAR,NPARA,
  2384. & VELCHE(IGAU,IEL),IERUT)
  2385. IF (IERUT.NE.0) THEN
  2386. INTERR(1)=IERUT
  2387. CALL ERREUR(957)
  2388. GOTO 9900
  2389. ENDIF
  2390. 671 CONTINUE
  2391. 670 CONTINUE
  2392.  
  2393. C Fin appel par librairie
  2394. ENDIF
  2395. C
  2396. SEGSUP,WRKEXT
  2397. C
  2398. *
  2399. endif
  2400. C
  2401. C---------------------------------------------------------
  2402. C traitement des composante d'autres types
  2403. C que 'REAL*8' 'EVOLUTIO' ou 'NUAGE ' ou 'LISTMOTS'
  2404. C---------------------------------------------------------
  2405. C
  2406. ELSE
  2407. C
  2408. TYPCHE(ICOMP)=CHA1
  2409. N1PTEL=0
  2410. N1EL =0
  2411. N2PTEL=1
  2412. N2EL =1
  2413. SEGINI MELVAL
  2414. IELVAL(ICOMP)=MELVAL
  2415. IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1)
  2416. C
  2417. ENDIF
  2418. C
  2419. 70 CONTINUE
  2420. * ajout d une composante pour IMPCOMPL
  2421. if (inatuu.eq.164.and.iptamo.gt.0) then
  2422. N2 = N2 + 1
  2423. segadj mchaml
  2424. typche(N2) = 'REAL*8'
  2425. nomche(N2) = 'VISC'
  2426. ielval(N2) = iptamo
  2427. endif
  2428. *'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2429. * FIN DE BOUCLE SUR LES COMPOSANTES
  2430. *'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2431. *
  2432. * cas simul
  2433. *
  2434. IF (JESIMU.EQ.1) THEN
  2435. *
  2436. * ON COMMENCE PAR ACTIVER TOUTES LES COMPOSANTES
  2437. * ET CREER LES MELVALS NON ENCORE CREES
  2438. *
  2439. DO 700 ICOMP=1,N2
  2440. IF (IVALIS(ICOMP).EQ.0) THEN
  2441. MELVAL=IELVAL(ICOMP)
  2442. NPMAX = MAX(NPMAX,VELCHE(/1))
  2443. NEMAX = MAX(NEMAX,VELCHE(/2))
  2444. ENDIF
  2445. 700 CONTINUE
  2446. DO 701 ICOMP=1,N2
  2447. IF (IVALIS(ICOMP).EQ.1) THEN
  2448. TYPCHE(ICOMP)='REAL*8 '
  2449. N1PTEL=NPMAX
  2450. N1EL=NEMAX
  2451. N2PTEL=0
  2452. N2EL=0
  2453. SEGINI MELVAL
  2454. IELVAL(ICOMP)=MELVAL
  2455. ENDIF
  2456. 701 CONTINUE
  2457. C
  2458. C Evaluation externe de la composante
  2459. C
  2460. DO 820 IEL=1,NEMAX
  2461. DO 821 IGAU=1,NPMAX
  2462. C
  2463. C Recuperation des parametres
  2464. C
  2465. DO 822 IPARA=1,NPARA
  2466. MELVA2=IVAPAR(IPARA)
  2467. N1PTE2=MELVA2.VELCHE(/1)
  2468. N1EL2=MELVA2.VELCHE(/2)
  2469. IF (N1PTE2.EQ.1) THEN
  2470. IF (N1EL2.EQ.1) THEN
  2471. VALPAR(IPARA)=MELVA2.VELCHE(1,1)
  2472. ELSE
  2473. VALPAR(IPARA)=MELVA2.VELCHE(1,IEL)
  2474. ENDIF
  2475. ELSE
  2476. VALPAR(IPARA)=MELVA2.VELCHE(IGAU,IEL)
  2477. ENDIF
  2478. 822 CONTINUE
  2479. *
  2480. * recuperation du tableau xval
  2481. *
  2482. DO 824 ICOMP=1,N2
  2483. MELVAL=IELVAL(ICOMP)
  2484. N1PTE1=VELCHE(/1)
  2485. N1EL1 =VELCHE(/2)
  2486. *
  2487. IF (N1PTE1.EQ.0.AND.N1EL1.EQ.0) THEN
  2488. XVAL(ICOMP)=0.
  2489. ELSE
  2490. IF (N1PTE1.EQ.1) THEN
  2491. IF (N1EL1.EQ.1) THEN
  2492. XVAL(ICOMP)=VELCHE(1,1)
  2493. ELSE
  2494. XVAL(ICOMP)=VELCHE(1,IEL)
  2495. ENDIF
  2496. ELSE
  2497. XVAL(ICOMP)=VELCHE(IGAU,IEL)
  2498. ENDIF
  2499. ENDIF
  2500. 824 CONTINUE
  2501. *
  2502. IERUT=0
  2503. CALL COMPUS(NOMVAL,XVAL,IVALIS,N2,
  2504. & NOMPAR,VALPAR,NPARA,CMNAME,IERUT)
  2505. IF (IERUT.NE.0) THEN
  2506. INTERR(1)=IERUT
  2507. CALL ERREUR(957)
  2508. GOTO 9900
  2509. ENDIF
  2510. *
  2511. * remplissage
  2512. *
  2513. DO 825 ICOMP=1,N2
  2514. IF (IVALIS(ICOMP).EQ.1) THEN
  2515. MELVAL=IELVAL(ICOMP)
  2516. VELCHE(IGAU,IEL) = XVAL(ICOMP)
  2517. ENDIF
  2518. 825 CONTINUE
  2519. *
  2520. 821 CONTINUE
  2521. 820 CONTINUE
  2522. *
  2523. * DESACTIVATIONS
  2524. *
  2525. SEGSUP,WRKEXT
  2526. C
  2527. ENDIF
  2528. *
  2529. *'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2530.  
  2531. SEGSUP SWORK
  2532. SEGSUP WRK53
  2533. SEGSUP WRKRES
  2534. IF (KNUAG) THEN
  2535. SEGSUP NOTYPE
  2536. NOMID=IPNOMC
  2537. if(lsupma)SEGSUP NOMID
  2538. ENDIF
  2539. IF (IAMOI.NE.0) SEGSUP IAMOI
  2540.  
  2541. 10 CONTINUE
  2542. C
  2543. C FIN de la boucle sur les sous-zones du MCHAML
  2544. C -----------------------------------------------
  2545. *
  2546. * - STATIQUE - MODAL cree composantes facultatives
  2547. *
  2548. IF (dstati.and.iret.ne.0) THEN
  2549. call varin6(ipmodl,iret)
  2550. if (ierr.ne.0) return
  2551. ENDIF
  2552.  
  2553. C Fin normale de VARINU
  2554. C =====================
  2555. NSOUS=ICHAML(/1)
  2556. DO IS = 1,NSOUS
  2557. MCHAML = ICHAML(IS)
  2558. DO im = 1,IELVAL(/1)
  2559. MELVAL = IELVAL(im)
  2560. CALL COMRED(MELVAL)
  2561. IELVAL(im)=MELVAL
  2562. ENDDO
  2563. ENDDO
  2564.  
  2565. RETURN
  2566.  
  2567. C Erreur dans une sous zone / desactivation et retour
  2568. C ===================================================
  2569. 9900 CONTINUE
  2570. SEGSUP MELVAL
  2571. C
  2572. 9910 CONTINUE
  2573. SEGSUP MCHAML
  2574. C
  2575. C
  2576. SEGSUP SWORK
  2577. SEGSUP WRK53
  2578. SEGSUP WRKRES
  2579. IF (IAMOI.NE.0) SEGSUP IAMOI
  2580. C
  2581. 9920 CONTINUE
  2582. 9930 CONTINUE
  2583. IRET=0
  2584. SEGSUP MCHELM
  2585.  
  2586. END
  2587.  
  2588.  
  2589.  
  2590.  
  2591.  

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