Télécharger nlovep.eso

Retour à la liste

Numérotation des lignes :

  1. C NLOVEP SOURCE AM 17/09/25 21:15:19 9566
  2. SUBROUTINE NLOVEP(IPCHCO,IPCHI,IPCHO,NLOC1,IRET)
  3. C_______________________________________________________________________
  4. C
  5. C VERIFICATION ET PREPARATION DU TRAVAIL SUR LA MOYENNE
  6. C NON LOCALE
  7. C
  8. C
  9. C Entrees:
  10. C --------
  11. C IPCHCO Pointeur sur un MCHAML de Connectivite
  12. C (ss-type CONNECTIVITE NON LOCAL)
  13. C IPCHI Pointeur sur un MCHAML de ss-type indifferentt
  14. C IPLMOT Pointeur sur un LISTMOTS de noms de composante
  15. C
  16. C Sorties:
  17. C --------
  18. C IRET=1 ou 0 si OK ou non
  19. C IPCHO pointeur sur le champ moyenne
  20. C NLOC1 pointeur sur l'arbre de calcul
  21. C
  22. C Appele par: NLOCA1
  23. C -----------
  24. C
  25. C Appel a:
  26. C --------
  27. C
  28. C DOUBLO : detection de doublon
  29. C LOADPO : lecture d'un point (pointeur --> x(3))
  30. C ELQUOI, IDENT, KOMCHA, COPIE8, DTCHEL
  31. C
  32. C P.PEGON 9/11/92
  33. C_______________________________________________________________________
  34. C
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8(A-H,O-Z)
  37. LOGICAL LMASS,LCARA
  38. *
  39. -INC CCOPTIO
  40. -INC SMCHAML
  41. -INC SMELEME
  42. -INC SMMODEL
  43. -INC SMLMOTS
  44. -INC SMINTE
  45. CHARACTER*(LCONMO) CONM
  46. *
  47. SEGMENT INFO
  48. INTEGER INFELL(JG)
  49. ENDSEGMENT
  50. *
  51. SEGMENT NOTYPE
  52. CHARACTER*16 TYPE (NBTYPE)
  53. ENDSEGMENT
  54. *
  55. SEGMENT MPTVAL
  56. INTEGER IPOS(NS) ,NSOF(NS)
  57. INTEGER IVAL(NCOSOU)
  58. CHARACTER*16 TYVAL(NCOSOU)
  59. ENDSEGMENT
  60. *
  61. SEGMENT WRK0
  62. INTEGER IRAGNT(NSOUCO),IDUMMM(2,NSOUCO),IDUPLI(NSOUCO)
  63. END SEGMENT
  64. *
  65. SEGMENT NLOC1
  66. INTEGER ILOC2(NZONEF),MOLOC2(NZONEF)
  67. END SEGMENT
  68. *
  69. SEGMENT NLOC2
  70. INTEGER MPCHAM (NDOUBL)
  71. INTEGER ILOC4 (NDOUBL)
  72. INTEGER MODLAC,MAILEF,MINTEF
  73. INTEGER MAILAC (NSZACC)
  74. INTEGER MINTAC (NSZACC)
  75. INTEGER ILOC3 (NSZACC)
  76. INTEGER ILOC3I,ILOC3O
  77. INTEGER MELCAR
  78. END SEGMENT
  79. *
  80. SEGMENT NLOC3
  81. INTEGER MELVAC (NCOMP)
  82. END SEGMENT
  83. *
  84. SEGMENT NLOC4
  85. INTEGER JCLE
  86. REAL*8 PT1(3),PT2(3),DISP
  87. INTEGER MELPNI,MELPLI
  88. END SEGMENT
  89. *
  90. PARAMETER ( NINF=3 )
  91. INTEGER INFOS(NINF)
  92. C
  93. PARAMETER(NCLE=5)
  94. CHARACTER*4 MCLE(NCLE)
  95. DATA MCLE/'NORM','TRAN','POIN','DROI','PLAN'/
  96. C
  97. C
  98. C ACTIVATION DU CHAMP DE CONNECTIVITE
  99. C
  100. MCHELM=IPCHCO
  101. SEGACT,MCHELM
  102. NSOUCO=ICHAML(/1)
  103. SEGINI,WRK0
  104. C
  105. C ACTIVATION DES SOUS-ZONES (MCHAML)
  106. C
  107. DO ISOUCO=1,NSOUCO
  108. MCHAML=ICHAML(ISOUCO)
  109. SEGACT,MCHAML
  110. END DO
  111. C
  112. C ON ETABLIT LA LISTE DES MAILLAGES
  113. C ACTIVATION DU SECOND MELVAL DU CHAMP DE CONNECTIVITE
  114. C QUI EST LE MODELE ASSOCIE AU SS-ZONES ACCESSIBLE
  115. C ON ETABLIT LA LISTE DE CES MODELES
  116. C ON DESACTIVE LE MELVAL
  117. C
  118. DO ISOUCO=1,NSOUCO
  119. IDUMMM(1,ISOUCO)=IMACHE(ISOUCO)
  120. MCHAML=ICHAML(ISOUCO)
  121. IRAGNT(ISOUCO)=ISOUCO
  122. NCOMP=IELVAL(/1)
  123. IF(NCOMP.LT.4.OR.NCOMP.GT.6)THEN
  124. CALL ERREUR(734)
  125. SEGSUP,WRK0
  126. GOTO 9999
  127. ENDIF
  128. IF(NOMCHE(2).NE.'PMOD')THEN
  129. MOTERR(1:4)='PMOD'
  130. CALL ERREUR(734)
  131. SEGSUP,WRK0
  132. GOTO 9999
  133. ENDIF
  134. IF(TYPCHE(2).NE.'POINTEURMMODEL')THEN
  135. MOTERR(1:4)='PMOD'
  136. MOTERR(5:12)='MODEL '
  137. CALL ERREUR(736)
  138. SEGSUP,WRK0
  139. GOTO 9999
  140. ENDIF
  141. MELVAL=IELVAL(2)
  142. SEGACT,MELVAL
  143. IDUMMM(2,ISOUCO)=IELCHE(1,1)
  144. SEGDES,MELVAL
  145. END DO
  146. C
  147. C ON ORDONNE LE TABLEAU IDUMMM EN GARDANT LA TRACE DES PERMUTATIONS
  148. C DANS IRAGNT
  149. C ON DETECTE LES DOUBLONS:
  150. C IDUPLI INDIQUE LE NOMBRE DE DOUBLON PAR ZONE EFFECTIVE
  151. C IDUMMM POINTE SUR LE MAILLAGE/MODELE DE LA ZONE EFFECTIVE
  152. C
  153. CALL DOUBLO(IDUMMM,IRAGNT,2,NSOUCO, NZONEF,IDUPLI)
  154. C
  155. C ON REMPLIT NLOC1 ET PARTIELLEMENT NLOC2
  156. C ON ACTIVE LES MMODEL
  157. C ON ACTIVE LES MAILLAGES EFFECTIFS
  158. C ON SUPRIME WRK0
  159. C
  160. J=0
  161. NSZACC=0
  162. SEGINI,NLOC1
  163. DO ISOUCF=1,NZONEF
  164. NDOUBL=IDUPLI(ISOUCF)
  165. SEGINI,NLOC2
  166. ILOC2(ISOUCF)=NLOC2
  167. MMODEL=IDUMMM(2,ISOUCF)
  168. MODLAC=MMODEL
  169. SEGACT,MMODEL
  170. DO IDOUBL=1,NDOUBL
  171. J=J+1
  172. MPCHAM(IDOUBL)=IRAGNT(J)
  173. ILOC4 (IDOUBL)=0
  174. END DO
  175. MELEME=IDUMMM(1,ISOUCF)
  176. MAILEF=MELEME
  177. SEGACT,MELEME
  178. END DO
  179. SEGSUP,WRK0
  180. C
  181. C ON ACTIVES LES IMODEL ET ON CONTINUE DE REMPLIR NLOC2
  182. C (MAILLAGE ET MINTE)
  183. C IL FAUT ACTIVER LE MINTE !!!!
  184. C ON VERIFIE AU PASSAGE QUE LA FORMULATION DU MODELE EST
  185. C BIEN MASSIVE ET EN FORMULATION NON-LOCALE
  186. C ... ET QUE SOIT LES LONGUEURS CARACTERISTIQUES SUR UNE MEME
  187. C SOUS-ZONE EFFECTIVE SONT IDENTIQUE OU QUE LE MELVAL DE LONGUEUR
  188. C CARACTERISTIQUE EST LE MEME. POUR CELA ON ACTIVE
  189. C ET ON DESACTIVE LE PREMIER MELVAL DU CHAMP DE CONNECTIVITE
  190. C
  191. C
  192. LMASS=.TRUE.
  193. LCARA=.TRUE.
  194.  
  195. * 1-ere boucle sur les zones effectives (NZONEF)
  196.  
  197. DO ISOUCF=1,NZONEF
  198. C
  199. NLOC2=ILOC2(ISOUCF)
  200. ILOC3I=0
  201. ILOC3O=0
  202. MMODEL=MODLAC
  203. NSZACC=KMODEL(/1)
  204. * PP 15/6/93
  205. NDOUBL=MPCHAM(/1)
  206. SEGADJ,NLOC2
  207. DO ISZACC=1,NSZACC
  208. IMODEL=KMODEL(ISZACC)
  209. SEGACT,IMODEL
  210. MELE=NEFMOD
  211. MFR=NUMMFR (MELE)
  212. IF (MFR .NE. 1) THEN
  213. CALL ERREUR(737)
  214. LMASS=.FALSE.
  215. ENDIF
  216. MAILAC(ISZACC)=IMAMOD
  217. INLOC=0
  218. IF(INFMOD(/1).GE.13) INLOC=-1*INFMOD(13)
  219. IF(INLOC.EQ.0) THEN
  220. CALL ERREUR(737)
  221. LMASS=.FALSE.
  222. ENDIF
  223. minte=infmod(7)
  224. MINTAC(ISZACC)=minte
  225. SEGACT,MINTE
  226.  
  227. ILOC3 (ISZACC)=0
  228. *
  229. END DO
  230. C
  231. ICHAMC=MPCHAM(1)
  232. MCHAML=ICHAML(ICHAMC)
  233. IF(NOMCHE(1).NE.'NLAR')THEN
  234. MOTERR(1:4)='NLAR'
  235. CALL ERREUR(734)
  236. LCARA=.FALSE.
  237. ELSEIF(TYPCHE(1).NE.'REAL*8')THEN
  238. MOTERR(1:4)='NLAR'
  239. MOTERR(5:12)='FLOTTANT'
  240. CALL ERREUR(736)
  241. LCARA=.FALSE.
  242. ENDIF
  243. IF(LCARA)THEN
  244. MELVAL=IELVAL(1)
  245. SEGACT,MELVAL
  246. MELCAR=MELVAL
  247. IF(VELCHE(/1).EQ.1.AND.VELCHE(/2).EQ.1)THEN
  248. XLCAR=VELCHE(1,1)
  249. ELSE
  250. XLCAR=0.D0
  251. ENDIF
  252. SEGDES,MELVAL
  253. NDOUBL=MPCHAM(/1)
  254. C
  255. DO IDOUBL=1,NDOUBL
  256. ICHAMC=MPCHAM(IDOUBL)
  257. MCHAML=ICHAML(ICHAMC)
  258. IF(NOMCHE(1).NE.'NLAR')THEN
  259. MOTERR(1:4)='NLAR'
  260. CALL ERREUR(734)
  261. LCARA=.FALSE.
  262. ELSEIF(TYPCHE(1).NE.'REAL*8')THEN
  263. MOTERR(1:4)='NLAR'
  264. MOTERR(5:12)='FLOTTANT'
  265. CALL ERREUR(736)
  266. LCARA=.FALSE.
  267. ENDIF
  268. IF(LCARA)THEN
  269. MELVAL=IELVAL(1)
  270. IF(XLCAR.EQ.0.D0)THEN
  271. MELVA1=MELCAR
  272. SEGACT,MELVAL,MELVA1
  273. IF(MELVA1.VELCHE(/1).EQ.VELCHE(/1).AND.
  274. > MELVA1.VELCHE(/2).EQ.VELCHE(/2))THEN
  275. XDIFNL=0.D0
  276. XMAXNL=0.D0
  277. DO IB=1,VELCHE(/2)
  278. DO IG=1,VELCHE(/1)
  279. XDIFNL=XDIFNL+
  280. > ABS(MELVA1.VELCHE(IG,IB)-VELCHE(IG,IB))
  281. XMAXNL=MAX(XMAXNL,MELVA1.VELCHE(IG,IB),
  282. > VELCHE(IG,IB))
  283. ENDDO
  284. ENDDO
  285. ELSE
  286. XDIFNL=1
  287. XMAXNL=1
  288. ENDIF
  289. IF(XMAXNL.EQ.0.D0.OR.XDIFNL.GT.XMAXNL*1.D-10)THEN
  290. CALL ERREUR(739)
  291. LCARA=.FALSE.
  292. ENDIF
  293. SEGDES,MELVAL,MELVA1
  294. C
  295. ELSE
  296. SEGACT,MELVAL
  297. IF(XLCAR.NE.VELCHE(1,1))THEN
  298. CALL ERREUR(738)
  299. LCARA=.FALSE.
  300. ENDIF
  301. SEGDES,MELVAL
  302. ENDIF
  303. ENDIF
  304. END DO
  305. ENDIF
  306. END DO
  307. * fin de la 1-ere boucle sur les zones effectives (NZONEF)
  308.  
  309. IF(.NOT.LMASS) GOTO 9998
  310. IF(.NOT.LCARA) GOTO 9998
  311. C
  312. C ON CREE UN HEADER DE MCHAML DE CONNECTIVITE SUR LES ZONES
  313. C EFFECTIVES
  314. C ON CREE UN HEADER DE MODELE SUR LES ZONES EFFECTIVES QUI
  315. C REPREND LE IMODEL ASSOCIE A LA ZONE COURANTE
  316. C
  317. L1=TITCHE(/1)
  318. N1=NZONEF
  319. N3=INFCHE(/2)
  320. SEGINI,MCHEL1
  321. MCHEL1.TITCHE=TITCHE
  322. MCHEL1.IFOCHE=IFOCHE
  323. SEGINI,MMODE1
  324.  
  325. * 2-eme boucle sur les zones effectives (NZONEF)
  326.  
  327. DO ISOUCF=1,NZONEF
  328. NLOC2=ILOC2(ISOUCF)
  329. ICHAMC=MPCHAM(1)
  330. MCHAML=ICHAML(ICHAMC)
  331. IMACHA=IMACHE(ICHAMC)
  332. MCHEL1.IMACHE(ISOUCF)=IMACHA
  333. MCHEL1.ICHAML(ISOUCF)=0
  334. MMODEL=MODLAC
  335. NSZACC=KMODEL(/1)
  336. DO ISZACC=1,NSZACC
  337. IMODEL=KMODEL(ISZACC)
  338. IF (IMAMOD.EQ.IMACHA)GOTO 1
  339. END DO
  340. CALL ERREUR(740)
  341. GOTO 9997
  342. 1 MINTEF=MINTAC(ISZACC)
  343. MMODE1.KMODEL(ISOUCF)=IMODEL
  344. MCHEL1.CONCHE(ISOUCF)=CONMOD
  345. DO J=1,N3
  346. MCHEL1.INFCHE(ISOUCF,J)=INFCHE(ICHAMC,J)
  347. END DO
  348. END DO
  349.  
  350. * fin de la 2-eme boucle sur les zones effectives (NZONEF)
  351.  
  352. C
  353. C PREPARATION DE NOTYPE POUR LE CHAMP A MOYENNER
  354. C
  355. NBTYPE=1
  356. SEGINI,NOTYPE
  357. TYPE(1)='REAL*8'
  358. C
  359. C ON VERIFIE LA COMPATIBILITE DES SUPPORTS GEOMETRIQUES ET
  360. C QUE LES COMPOSANTES NECESSAIRES EXISTENT SUR TOUTES LES
  361. C ZONE EFFECTIVES
  362. C
  363.  
  364. * 3-eme boucle sur les zones effectives (NZONEF)
  365.  
  366. MMODEL=MMODE1
  367. DO ISOUCF=1,NZONEF
  368. NLOC2=ILOC2(ISOUCF)
  369. IMODEL=KMODEL(ISOUCF)
  370. CONM=CONMOD
  371. IPMAIL=IMAMOD
  372. CALL IDENT(IPMAIL,CONM,IPCHI,MCHEL1,INFOS,IRTD)
  373. IF(IRTD .NE. 1)THEN
  374. CALL ERREUR(741)
  375. GOTO 9996
  376. ENDIF
  377.  
  378. * ON RECUPERE 'LVIA'
  379.  
  380. MLMOTS=INFMOD(14)
  381. SEGACT,MLMOTS
  382. NBROBL=MOTS(/2)
  383.  
  384. * DANS LE CAS 'SB' ON COMPLETE LE LISTMOTS SI BESOIN
  385.  
  386.  
  387. * ON CREE LE NOMID ASSOCIE ET ON LE STOCKE DANS NLOC2
  388.  
  389. NBRFAC=0
  390. SEGINI,NOMID
  391. MOMOTS=NOMID
  392. DO IE1=1,NBROBL
  393. LESOBL(IE1)=MOTS(IE1)
  394. END DO
  395. SEGDES,MLMOTS
  396. MOLOC2(ISOUCF)=MOMOTS
  397.  
  398. INLOC=-1*INFMOD(13)
  399. IF(INLOC.EQ.2.AND.NBROBL.EQ.1) THEN
  400. NBROBL=15
  401. SEGADJ, NOMID
  402. LESOBL(2) ='SI11';
  403. LESOBL(3) ='SI22';
  404. LESOBL(4) ='SI33';
  405. LESOBL(5) ='COX1';
  406. LESOBL(6) ='COY1';
  407. LESOBL(7) ='COZ1';
  408. LESOBL(8) ='COX2';
  409. LESOBL(9) ='COY2';
  410. LESOBL(10)='COZ2';
  411. LESOBL(11)='COX3';
  412. LESOBL(12)='COY3';
  413. LESOBL(13)='COZ3';
  414. LESOBL(14)='SBFT';
  415. LESOBL(15)='LONG';
  416. ENDIF
  417.  
  418.  
  419. * ON PEUT ALORS VERIFIER LA PRESENCE DES COMPOSANTES NECESSAIRES
  420.  
  421. CALL KOMCHA(IPCHI,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  422. > INFOS,3,IVAMOT)
  423. IF (IERR .NE. 0) THEN
  424. CALL ERREUR(742)
  425. GOTO 9996
  426. ENDIF
  427. MPTVAL=IVAMOT
  428. NCOMP=IVAL(/1)
  429. SEGINI,NLOC3
  430. ILOC3I=NLOC3
  431. DO ICOMP=1,NCOMP
  432. MELVAC(ICOMP)=IVAL(ICOMP)
  433. END DO
  434. SEGSUP,MPTVAL
  435. END DO
  436.  
  437. * fin de la 3-eme boucle sur les zones effectives (NZONEF)
  438.  
  439. C
  440. C ON VERIFIE QUE LES MINTE EXISTENT ET QU'ILS SONT AUX PT DE GAUSS
  441. C POUR LE CHAMP A MOYENNER
  442. C
  443.  
  444. * 4-eme boucle sur les zones effectives (NZONEF)
  445.  
  446. MCHEL2=IPCHI
  447. SEGACT,MCHEL2
  448. DO ISOUCF=1,NZONEF
  449. IMODEL=KMODEL(ISOUCF)
  450. CONM=CONMOD
  451. IPMAIL=IMAMOD
  452. DO J=1,MCHEL2.CONCHE(/2)
  453. IF((MCHEL2.CONCHE(J).EQ.CONM)
  454. > .AND.(MCHEL2.IMACHE(J).EQ.IPMAIL))THEN
  455. IF((MCHEL2.INFCHE(J,4).EQ.0)
  456. > .OR.(MCHEL2.INFCHE(J,6).NE.5))THEN
  457. CALL ERREUR(745)
  458. GOTO 9996
  459. ENDIF
  460. ENDIF
  461. END DO
  462. END DO
  463. SEGDES,MCHEL2
  464.  
  465. * fin de la 4-eme boucle sur les zones effectives (NZONEF)
  466.  
  467. C
  468. C ON CONTINUE LA VERIFICATION DU MCHELM DES
  469. C CONNECTIVITES
  470. C ON CONTINUE DE REMPLIR NLOC2 ET ON CREE ET REMPLIT LES NLOC4
  471. C PAR OUVERTURE/FERMETURE DE MELVAL
  472. C
  473.  
  474. * 5-eme boucle sur les zones effectives (NZONEF)
  475.  
  476. DO ISOUCF=1,NZONEF
  477. NLOC2=ILOC2(ISOUCF)
  478. NDOUBL=MPCHAM(/1)
  479. DO IDOUBL=1,NDOUBL
  480. ICHAMC=MPCHAM(IDOUBL)
  481. CONM=CONCHE(ICHAMC)
  482. SEGINI,NLOC4
  483. ILOC4(IDOUBL)=NLOC4
  484. DO ICLE=1,NCLE
  485. IF(CONM(13:16) .EQ. MCLE(ICLE))GOTO 2
  486. END DO
  487. CALL ERREUR(746)
  488. GOTO 9996
  489. 2 JCLE=ICLE
  490. MCHAML=ICHAML(ICHAMC)
  491. NCOMP=IELVAL(/1)
  492. GOTO (11,12,13,14,15),ICLE
  493. C NORM
  494. 11 CONTINUE
  495. IF(NCOMP.NE.4)GOTO 16
  496. GOTO 17
  497. C TRAN
  498. 12 CONTINUE
  499. IF(NCOMP.NE.5)GOTO 16
  500. IF (NOMCHE(5).NE.'POT1')THEN
  501. MOTERR(1:4)='POT1'
  502. MOTERR(13:16)='TRAN'
  503. CALL ERREUR(743)
  504. GOTO 9996
  505. ENDIF
  506. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  507. MOTERR(1:4)='POT1'
  508. MOTERR(5:12)='POINT '
  509. MOTERR(13:16)='TRAN'
  510. CALL ERREUR(744)
  511. GOTO 9996
  512. ENDIF
  513. MELVAL=IELVAL(5)
  514. SEGACT,MELVAL
  515. JPT1=IELCHE(1,1)
  516. SEGDES,MELVAL
  517. CALL LOADPO(JPT1,PT1)
  518. GOTO 17
  519. C POIN
  520. 13 CONTINUE
  521. IF(NCOMP.NE.5)GOTO 16
  522. IF (NOMCHE(5).NE.'POT1')THEN
  523. MOTERR(1:4)='POT1'
  524. MOTERR(13:16)='POIN'
  525. CALL ERREUR(743)
  526. GOTO 9996
  527. ENDIF
  528. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  529. MOTERR(1:4)='POT1'
  530. MOTERR(5:12)='POINT '
  531. MOTERR(13:16)='POIN'
  532. CALL ERREUR(744)
  533. GOTO 9996
  534. ENDIF
  535. MELVAL=IELVAL(5)
  536. SEGACT,MELVAL
  537. JPT1=IELCHE(1,1)
  538. SEGDES,MELVAL
  539. CALL LOADPO(JPT1,PT1)
  540. GOTO 17
  541. C DROI
  542. 14 CONTINUE
  543. IF(NCOMP.NE.6)GOTO 16
  544. IF (NOMCHE(5).NE.'POT1')THEN
  545. MOTERR(1:4)='POT1'
  546. MOTERR(13:16)='DROI'
  547. CALL ERREUR(743)
  548. GOTO 9996
  549. ENDIF
  550. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  551. MOTERR(1:4)='POT1'
  552. MOTERR(5:12)='POINT '
  553. MOTERR(13:16)='DROI'
  554. CALL ERREUR(744)
  555. GOTO 9996
  556. ENDIF
  557. MELVAL=IELVAL(5)
  558. SEGACT,MELVAL
  559. JPT1=IELCHE(1,1)
  560. SEGDES,MELVAL
  561. CALL LOADPO(JPT1,PT1)
  562. IF (NOMCHE(6).NE.'POT2')THEN
  563. MOTERR(1:4)='POT2'
  564. MOTERR(13:16)='DROI'
  565. CALL ERREUR(743)
  566. GOTO 9996
  567. ENDIF
  568. IF (TYPCHE(6).NE.'POINTEURPOINT ')THEN
  569. MOTERR(1:4)='POT2'
  570. MOTERR(5:12)='POINT '
  571. MOTERR(13:16)='DROI'
  572. CALL ERREUR(744)
  573. GOTO 9996
  574. ENDIF
  575. MELVAL=IELVAL(6)
  576. SEGACT,MELVAL
  577. JPT2=IELCHE(1,1)
  578. SEGDES,MELVAL
  579. CALL LOADPO(JPT2,PT2)
  580. GOTO 17
  581. C PLAN
  582. 15 CONTINUE
  583. IF(NCOMP.NE.6)GOTO 16
  584. IF (NOMCHE(5).NE.'POT1')THEN
  585. MOTERR(1:4)='POT1'
  586. MOTERR(13:16)='PLAN'
  587. CALL ERREUR(743)
  588. GOTO 9996
  589. ENDIF
  590. IF (TYPCHE(5).NE.'POINTEURPOINT ')THEN
  591. MOTERR(1:4)='POT1'
  592. MOTERR(5:12)='POINT '
  593. MOTERR(13:16)='PLAN'
  594. CALL ERREUR(744)
  595. GOTO 9996
  596. ENDIF
  597. MELVAL=IELVAL(5)
  598. SEGACT,MELVAL
  599. JPT1=IELCHE(1,1)
  600. SEGDES,MELVAL
  601. CALL LOADPO(JPT1,PT1)
  602. IF (NOMCHE(6).NE.'DISP')THEN
  603. MOTERR(1:4)='DISP'
  604. MOTERR(13:16)='PLAN'
  605. CALL ERREUR(743)
  606. GOTO 9996
  607. ENDIF
  608. IF (TYPCHE(6).NE.'REAL*8')THEN
  609. MOTERR(1:4)='DISP'
  610. MOTERR(5:12)='FLOTTANT'
  611. MOTERR(13:16)='PLAN'
  612. CALL ERREUR(744)
  613. GOTO 9996
  614. ENDIF
  615. MELVAL=IELVAL(6)
  616. SEGACT,MELVAL
  617. DISP=VELCHE(1,1)
  618. SEGDES,MELVAL
  619. GOTO 17
  620. C
  621. 16 CONTINUE
  622. CALL ERREUR(734)
  623. GOTO 9996
  624. C
  625. 17 CONTINUE
  626. IF (NOMCHE(3).NE.'NPNI')THEN
  627. MOTERR(1:4)='NPNI'
  628. CALL ERREUR(734)
  629. GOTO 9996
  630. ENDIF
  631. IF (TYPCHE(3).NE.'POINTEURLISTENTI')THEN
  632. MOTERR(1:4)='NPNI'
  633. MOTERR(5:12)='LISTENTI'
  634. CALL ERREUR(736)
  635. GOTO 9996
  636. ENDIF
  637. MELPNI=IELVAL(3)
  638. IF (NOMCHE(4).NE.'NPLI')THEN
  639. MOTERR(1:4)='NPLI'
  640. CALL ERREUR(734)
  641. GOTO 9996
  642. ENDIF
  643. IF (TYPCHE(4).NE.'POINTEURLISTENTI')THEN
  644. MOTERR(1:4)='NPLI'
  645. MOTERR(5:12)='LISTENTI'
  646. CALL ERREUR(736)
  647. GOTO 9996
  648. ENDIF
  649. MELPLI=IELVAL(4)
  650. END DO
  651. END DO
  652.  
  653. * fin de la 5-eme boucle sur les zones effectives (NZONEF)
  654.  
  655. C
  656. C ON VERIFIE QUE SUR CHAQUE SS-ZONE EFFECTIVE ON A UN ICLE=1 ET
  657. C UN SEUL
  658. C
  659.  
  660. * 6-eme boucle sur les zones effectives (NZONEF)
  661.  
  662. DO ISOUCF=1,NZONEF
  663. NLOC2=ILOC2(ISOUCF)
  664. NDOUBL=ILOC4(/1)
  665. KCLE=0
  666. DO IDOUBL=1,NDOUBL
  667. NLOC4=ILOC4(IDOUBL)
  668. IF(JCLE.EQ.1)KCLE=KCLE+1
  669. END DO
  670. IF(KCLE.EQ.0)THEN
  671. CALL ERREUR(747)
  672. GOTO 9996
  673. ENDIF
  674. IF(KCLE.GT.1)THEN
  675. CALL ERREUR(748)
  676. GOTO 9996
  677. ENDIF
  678. END DO
  679.  
  680. * fin de la 6-eme boucle sur les zones effectives (NZONEF)
  681.  
  682. C
  683. C ON COPIE LE CHAMELEM A MOYENNER
  684. C
  685. CALL COPIE8 (IPCHI,IPCHO)
  686. C
  687. C ON FINIT DE REMPLIR NLOC2 ET ON CREE ET REMPLIT LES NLOC3
  688. C LES MELVAL RESULTATS DE MOYENNE CONSTANT SONT SEGADJUSTES
  689. C
  690.  
  691. * 7-eme boucle sur les zones effectives (NZONEF)
  692.  
  693. DO ISOUCF=1,NZONEF
  694. NLOC2=ILOC2(ISOUCF)
  695. MOMOTS=MOLOC2(ISOUCF)
  696. C
  697. MMODEL=MODLAC
  698. NSZACC=KMODEL(/1)
  699. DO ISZACC=1,NSZACC
  700. IMODEL=KMODEL(ISZACC)
  701. CONM=CONMOD
  702. IPMAIL=IMAMOD
  703. CALL IDENT(IPMAIL,CONM,IPCHI,MCHEL1,INFOS,IRTD)
  704. CALL KOMCHA(IPCHI,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  705. > INFOS,3,IVAMOT)
  706. MPTVAL=IVAMOT
  707. NCOMP=IVAL(/1)
  708. SEGINI,NLOC3
  709. ILOC3(ISZACC)=NLOC3
  710. DO ICOMP=1,NCOMP
  711. MELVAC(ICOMP)=IVAL(ICOMP)
  712. END DO
  713. SEGSUP,MPTVAL
  714. END DO
  715. C
  716. IMODEL=MMODE1.KMODEL(ISOUCF)
  717. CONM=CONMOD
  718. IPMAIL=IMAMOD
  719. CALL IDENT(IPMAIL,CONM,IPCHO,MCHEL1,INFOS,IRTD)
  720. CALL KOMCHA(IPCHO,IPMAIL,CONM,MOMOTS,NOTYPE,1,
  721. > INFOS,3,IVAMOT)
  722. MPTVAL=IVAMOT
  723. NCOMP=IVAL(/1)
  724. SEGINI,NLOC3
  725. ILOC3O=NLOC3
  726. DO ICOMP=1,NCOMP
  727. MELVAC(ICOMP)=IVAL(ICOMP)
  728. END DO
  729. SEGSUP,MPTVAL
  730. C
  731. IPT1=IPMAIL
  732. N1EL=IPT1.NUM(/2)
  733. MINTE=MINTEF
  734. N1PTEL=POIGAU(/1)
  735. DO ICOMP=1,NCOMP
  736. MELVAL=MELVAC(ICOMP)
  737. C SI LE CHAMP N"EST PAS DANS SES BORNES ...
  738. IF((VELCHE(/1).NE.N1PTEL).OR.(VELCHE(/2).NE.N1EL))THEN
  739. C ... IL EST CONSTANT
  740. IF((VELCHE(/1).EQ.1).AND.(VELCHE(/2).EQ.1))THEN
  741. * PP 15/6/93
  742. N2PTEL=IELCHE(/1)
  743. N2EL=IELCHE(/2)
  744. SEGADJ,MELVAL
  745. XELCHE=VELCHE(1,1)
  746. DO I1EL=1,N1EL
  747. DO I1PTEL=1,N1PTEL
  748. VELCHE(I1PTEL,I1EL)=XELCHE
  749. END DO
  750. END DO
  751. C ... OU IL EST CONSTANT PAR ELEMENT
  752. ELSE IF (VELCHE(/1).EQ.1)THEN
  753. IF(VELCHE(/2).NE.N1EL)THEN
  754. CALL ERREUR(749)
  755. GOTO 9995
  756. ENDIF
  757. * PP 15/6/93
  758. N2PTEL=IELCHE(/1)
  759. N2EL=IELCHE(/2)
  760. SEGADJ MELVAL
  761. DO I1EL=1,N1EL
  762. XELCHE=VELCHE(1,I1EL)
  763. DO I1PTEL=1,N1PTEL
  764. VELCHE(I1PTEL,I1EL)=XELCHE
  765. END DO
  766. END DO
  767. C ... OU IL EST ERRONE
  768. ELSE
  769. CALL ERREUR(750)
  770. GOTO 9995
  771. ENDIF
  772. ENDIF
  773. END DO
  774. END DO
  775.  
  776. * fin de la 7-eme boucle sur les zones effectives (NZONEF)
  777.  
  778. C
  779. C ON ACTIVE LES MELVAL DE CONNECTIVITE
  780. C
  781.  
  782. * 8-eme boucle sur les zones effectives (NZONEF)
  783.  
  784. DO ISOUCF=1,NZONEF
  785. NLOC2=ILOC2 (ISOUCF)
  786. MELVAL=MELCAR
  787. SEGACT,MELVAL
  788. NDOUBL=ILOC4(/1)
  789. DO IDOUBL=1,NDOUBL
  790. NLOC4=ILOC4(IDOUBL)
  791. MELVAL=MELPNI
  792. SEGACT,MELVAL
  793. MELVAL=MELPLI
  794. SEGACT,MELVAL
  795. END DO
  796. END DO
  797.  
  798. * fin de la 8-eme boucle sur les zones effectives (NZONEF)
  799.  
  800. C
  801. C ON DESACTIVE LE MCHELM,MCHAML DE CONNECTIVITE
  802. C
  803. DO ISOUCO=1,NSOUCO
  804. MCHAML=ICHAML(ISOUCO)
  805. SEGDES,MCHAML
  806. END DO
  807. SEGDES,MCHELM
  808. C
  809. C ON SORT (SANS ERREUR ???)
  810. C
  811. DO ISOUCF=1,NZONEF
  812. NOMID=MOLOC2(ISOUCF)
  813. SEGSUP,NOMID
  814. ENDDO
  815. SEGSUP,NOTYPE
  816. SEGSUP,MCHEL1
  817. SEGSUP,MMODE1
  818. IRET=1
  819. RETURN
  820. C
  821. C TRAITEMENT DES ERREURS
  822. C
  823. 9995 CONTINUE
  824. CALL DTCHEL(IPCHO)
  825. 9996 CONTINUE
  826. DO ISOUCF=1,NZONEF
  827. NLOC2=ILOC2 (ISOUCF)
  828. NDOUBL=ILOC4(/1)
  829. DO IDOUBL=1,NDOUBL
  830. IF(ILOC4(IDOUBL).NE.0)THEN
  831. NLOC4=ILOC4(IDOUBL)
  832. SEGSUP,NLOC4
  833. ENDIF
  834. END DO
  835. NSZACC=ILOC3(/1)
  836. DO ISZACC=1,NSZACC
  837. IF(ILOC3(ISZACC).NE.0)THEN
  838. NLOC3=ILOC3(ISZACC)
  839. SEGSUP,NLOC3
  840. END IF
  841. END DO
  842. IF (ILOC3O.NE.0)THEN
  843. NLOC3=ILOC3O
  844. SEGSUP,NLOC3
  845. END IF
  846. IF (ILOC3I.NE.0)THEN
  847. NLOC3=ILOC3I
  848. NCOMP=MELVAC(/1)
  849. DO ICOMP=1,NCOMP
  850. MELVAL=MELVAC (ICOMP)
  851. SEGDES,MELVAL
  852. END DO
  853. SEGSUP,NLOC3
  854. ENDIF
  855. END DO
  856. 9997 CONTINUE
  857. NOMID=MOMOTS
  858. SEGSUP,NOMID,NOTYPE
  859. SEGSUP,MCHEL1
  860. SEGSUP,MMODE1
  861. 9998 CONTINUE
  862. DO ISOUCF=1,NZONEF
  863. NLOC2=ILOC2 (ISOUCF)
  864. MELEME=MAILEF
  865. MMODEL=MODLAC
  866. NSZACC=KMODEL(/1)
  867. DO ISZACC=1,NSZACC
  868. MINTE=MINTAC(ISZACC)
  869. SEGDES,MINTE
  870. IMODEL=KMODEL(ISZACC)
  871. SEGDES,IMODEL
  872. END DO
  873. SEGDES,MELEME
  874. END DO
  875. DO ISOUCF=1,NZONEF
  876. NLOC2=ILOC2 (ISOUCF)
  877. MMODEL=MODLAC
  878. SEGDES,MMODEL
  879. SEGSUP,NLOC2
  880. END DO
  881. SEGSUP,NLOC1
  882. 9999 CONTINUE
  883. DO ISOUCO=1,NSOUCO
  884. MCHAML=ICHAML(ISOUCO)
  885. SEGDES,MCHAML
  886. END DO
  887. SEGDES,MCHELM
  888. C
  889. IRET=0
  890. RETURN
  891. END
  892.  
  893.  
  894.  
  895.  
  896.  
  897.  
  898.  
  899.  
  900.  
  901.  
  902.  
  903.  
  904.  
  905.  
  906.  
  907.  
  908.  

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