Télécharger varinu.eso

Retour à la liste

Numérotation des lignes :

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

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