Télécharger varinu.eso

Retour à la liste

Numérotation des lignes :

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

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