Télécharger ytclsf.eso

Retour à la liste

Numérotation des lignes :

  1. C YTCLSF SOURCE PV 17/09/29 21:16:17 9578
  2. SUBROUTINE YTCLSF(CHHH,NOMPR)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C CET OPERATEUR DISCRETISE TOUT
  8. C
  9. C SYNTAXE :
  10. C ---------
  11. C
  12. C s m = OPER $mod LSMOT1 LSMOT2 <OPTION>
  13. C <TRANS> DT SCHT TN <UN> <TN-1 <UN-2>>
  14. C <PERM> TN <UN>
  15. C <PROJ> DT SCHT TN <UN> <TN-1 <UN-2>>
  16. C <COEF1 <COEF2 <COEF3>>>
  17. C
  18. C
  19. C OPTIONs LINE MACRO QUAF LINB ISOQ
  20. C CENTREP0 CENTREP1 CENTRE MSOMMET RIGIDITE MDIA
  21. C CENTREE SUPG SUPGDC CMD a CONS STABP
  22. C xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
  23. C
  24. C SCHT EUL_EXPL EUL_IMPL CN CNG BDF2 SEMI b
  25. C
  26. C
  27. C
  28. C COEFFICIENTS :
  29. C --------------
  30. C
  31. C
  32. C ALF (SCAL DOMA) DIFFUSIVITE THERMIQUE
  33. C (SCAL ELEM)
  34. C (SCAL NOEU)
  35. C
  36. C INCONNUES :
  37. C -----------
  38. C
  39. C TN CHAMP DE TEMPERATURE
  40. C UN CHAMP DE VITESSE
  41. C PN CHAMP DE PRESSION
  42. C
  43. C INCOD Type inconnue duale : VITEsse TEMPerature ou PRESsion
  44. C MPRE Type pression : CENTRE CENTREP1 CENTREP0 MSOMMET
  45. C
  46. C IHV=0 SCALAIRE
  47. C IHV=1 VITESSE
  48. C
  49. C IKAS = 1 KMAB calcul B (Div U)
  50. C IKAS = 2 KMBT calcul Bt (Grad p)
  51. C IKAS = 3 KBBT calcul B assemble B et Bt
  52. C
  53. C TTRAN Transitoire/permanent VRAI/FAUX
  54. C TDFDT on discretise dfdt => TTRAN vrai sinon erreur
  55. C (en permanent pour NS TDFDT faux)
  56. C (en transitoire pour LAPN TDFDT faux)
  57. C TPROJ Projection => TTRAN vrai
  58. C
  59. C
  60. C************************************************************************
  61.  
  62. -INC CCOPTIO
  63. -INC CCREEL
  64. -INC CCGEOME
  65. -INC SMCOORD
  66. -INC SMLENTI
  67. POINTEUR MLENT4.MLENTI
  68. -INC SMLMOTS
  69. -INC SMMODEL
  70. -INC SMELEME
  71. POINTEUR IGEOM.MELEME,MELEMS.MELEME,MELEMC.MELEME,MELEMP.MELEME
  72. POINTEUR MELEM2.MELEME
  73. POINTEUR MELEMA.MELEME,MELSTB.MELEME
  74. -INC SMCHPOI
  75. POINTEUR MTETA1.MPOVAL,MTETA2.MPOVAL,MTETA3.MPOVAL,MTETA4.MPOVAL
  76. -INC SMTABLE
  77. POINTEUR MTABZ.MTABLE
  78. -INC SIZFFB
  79. POINTEUR IZF1.IZFFM,IZH2.IZHR,IZW.IZFFM,IZWH.IZHR
  80. SEGMENT SAJT
  81. REAL*8 AJT(IDIM,IDIM,NPG),RF1(NP,MP,IDIM),SM1(NP,IDIM)
  82. REAL*8 TN1(NP,IDIM),TN2(NP,IDIM)
  83. REAL*8 WT(NP,NPG),WS(NP,NPG)
  84. ENDSEGMENT
  85. -INC SMRIGID
  86. C-INC SMMATRIK
  87. C*******************************************************************
  88. C
  89. SEGMENT MATRIK
  90. REAL*8 COEMTK(NMATRI)
  91. INTEGER JRIGEL(NRIGE,NMATRI)
  92. INTEGER KSYM,KMINC,KMINCP,KMINCD,KIZM
  93. INTEGER KISPGT,KISPGP,KISPGD
  94. INTEGER KNTTT,KNTTP,KNTTD
  95. INTEGER KIDMAT(NKID)
  96. INTEGER KKMMT(NKMT)
  97. ENDSEGMENT
  98.  
  99. SEGMENT JMATRI
  100. CHARACTER*8 LISPRI(NBMF),LJSDUA(NBMF)
  101. INTEGER LIZAFM(NBSOUS,NBMF)
  102. INTEGER KSPGP,KSPGD
  103. ENDSEGMENT
  104. POINTEUR JMATRS.JMATRI,JMATR1.JMATRI,JMATR2.JMATRI,JMATR3.JMATRI
  105.  
  106. C Stokage matrices elementaires non assemblees (valeurs)
  107. SEGMENT IZAFM
  108. REAL*8 AM(NBEL,NP,MP)
  109. ENDSEGMENT
  110. POINTEUR IPM1.IZAFM,IPM2.IZAFM,IPM3.IZAFM,IPM4.IZAFM
  111.  
  112. C*******************************************************************
  113. POINTEUR IPM.IZAFM
  114. -INC SMCHAML
  115.  
  116. LOGICAL TLAPN,TDFDT,TCONV,TSOUR,TECHI,TMDIA,TMASS,TKBBT,TVNIP
  117. LOGICAL ICAL2,ICAL3,TVITP,TTRAN,TPROJ,TLINCO
  118. LOGICAL XDIAG,XPG,XTV,XTG,XBDF
  119. LOGICAL XRIG,XCONS
  120. CHARACTER*8 CHHH,TYPE,NOM,NOM0,CHAI,SCHT,NOMPER,NOMPR,MPRE
  121. CHARACTER*4 INCOD
  122. CHARACTER*4 NOMI(3),NOMA(3),NOMP(3),NOMD(3)
  123. PARAMETER (NBH=7,NBO=24)
  124. CHARACTER*8 LSCHE(NBH),LSOPT(NBO)
  125. DATA LSOPT /'LINE ','MACRO ','QUAF ','LINB ',
  126. & 'ISOQ ','MMDIAGO ','RGDT ','CONS ','TRANS ',
  127. & 'PERM ','PROJ ','STABP ',' ',' ',
  128. & 'CENTRE ','CENTREP0','CENTREP1','MSOMMET ',' ',
  129. & ' ','CMD ','CENTREE ','SUPGDC ','SUPG '/
  130. DATA LSCHE /'EUL_EXPL','EUL_IMPL','TVISQ ','SEMI ',
  131. & 'CN ','CNG ','BDF2 '/
  132. DIMENSION ICOEF(4),SU(3)
  133. C*****************************************************************************
  134. CTCLSF
  135. NOMPER=NOMPR
  136. c write(6,*)' DEBUT YTCLSF appele par ',NOMPER
  137. NBMF=1
  138. IDCEN=1
  139.  
  140. C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  141. C KPOIND support dual du schéma d'intégration
  142. KPOIND=0
  143.  
  144. TVNIP=.FALSE.
  145. TPROJ=.FALSE.
  146. TTRAN=.FALSE.
  147. TLAPN=.FALSE.
  148. TDFDT=.FALSE.
  149. TCONV=.FALSE.
  150. TSOUR=.FALSE.
  151. TECHI=.FALSE.
  152. TMDIA=.FALSE.
  153. TMASS=.FALSE.
  154. TKBBT=.FALSE.
  155. TVITP=.FALSE.
  156.  
  157. L=0
  158. 21 CONTINUE
  159. L=L+1
  160. IF(CHHH(L:L).EQ.'T')TDFDT=.TRUE.
  161. IF(CHHH(L:L).EQ.'L')TLAPN=.TRUE.
  162. IF(CHHH(L:L).EQ.'C')TCONV=.TRUE.
  163. IF(CHHH(L:L).EQ.'S')TSOUR=.TRUE.
  164. IF(CHHH(L:L).EQ.'V')TVNIP=.TRUE.
  165. IF(CHHH(L:L).EQ.'K')THEN
  166. TKBBT=.TRUE.
  167. L=L+1
  168. IKAS=0
  169. IF(CHHH(L:L).EQ.'1')IKAS=1
  170. IF(CHHH(L:L).EQ.'2')IKAS=2
  171. IF(CHHH(L:L).EQ.'3')IKAS=3
  172. ENDIF
  173. C E et M sont exclusifs
  174. IF(CHHH(L:L).EQ.'E')TECHI=.TRUE.
  175. IF(CHHH(L:L).EQ.'M')TMDIA=.TRUE.
  176. IF(L.LT.8)GO TO 21
  177.  
  178. IF(TECHI)THEN
  179. IF(TDFDT.OR.TLAPN.OR.TCONV.OR.TSOUR.OR.TMDIA)THEN
  180. C Données incompatibles
  181. WRITE(IOIMP,*)'Operateur : ',NOMPER
  182. CALL ERREUR(21)
  183. RETURN
  184. ENDIF
  185. TMASS=.TRUE.
  186. TSOUR=.TRUE.
  187. ENDIF
  188.  
  189. IF(TMDIA)THEN
  190. IF(TDFDT.OR.TLAPN.OR.TCONV.OR.TSOUR.OR.TECHI)THEN
  191. C Données incompatibles
  192. WRITE(IOIMP,*)'Operateur : ',NOMPER
  193. CALL ERREUR(21)
  194. RETURN
  195. ENDIF
  196. TMASS=.TRUE.
  197. ENDIF
  198.  
  199. IF(TKBBT.OR.TVNIP)TVITP=.TRUE.
  200. IF(TVNIP)NOMPER='VNIMP'
  201.  
  202. C
  203. C Lecture du model et verification OK NAVIER_STOKES
  204. C
  205. TYPE='MMODEL'
  206. CALL LIROBJ(TYPE,MMODEL,1,IRET)
  207.  
  208. IF(IRET.EQ.0)THEN
  209. C On ne trouve pas d'objet de type %m1:8
  210. MOTERR( 1: 8) = 'MMODEL '
  211. WRITE(IOIMP,*)'Operateur : ',NOMPER
  212. CALL ERREUR(37)
  213. RETURN
  214. ENDIF
  215.  
  216. CALL LEKMOD(MMODEL,MTABZ,INEFMD)
  217. IF(MTABZ.EQ.0)THEN
  218. C% Le modele %m1:8 %m9:16 est obligatoire.
  219. MOTERR( 1: 8) = 'NAVIER_S'
  220. MOTERR( 9:16) = 'TOKES '
  221. WRITE(IOIMP,*)'Operateur : ',NOMPER
  222. CALL ERREUR(935)
  223. RETURN
  224. ENDIF
  225. INEFM0=INEFMD
  226.  
  227. C /S INEFMD : Type formulation
  228. C INEFMD = 1 LINE,
  229. C = 2 MACRO,
  230. C = 3 QUADRATIQUE,
  231. C = 4 LINB.
  232. C = 5 ISOQ.
  233. IF(INEFMD.NE.1.AND.INEFMD.NE.2.AND.INEFMD.NE.3.AND.
  234. & INEFMD.NE.4.AND.INEFMD.NE.5)THEN
  235. * Le type d'élément fini ne convient pas
  236. MOTERR( 1: 8) =' '
  237. WRITE(IOIMP,*)'Operateur : ',NOMPER
  238. CALL ERREUR(926)
  239. RETURN
  240. ENDIF
  241. C*************************************************************************
  242. C Lecture des Noms d'Inco(s) et type d'Inco(s)
  243. TYPE='LISTMOTS'
  244. CALL LIROBJ(TYPE,MLMOT3,1,IRET)
  245. IF(IRET.EQ.0)THEN
  246. C On ne trouve pas d'objet de type %m1:8
  247. MOTERR( 1: 8) = 'LISTMOTS'
  248. WRITE(IOIMP,*)'Operateur : ',NOMPER
  249. CALL ERREUR(37)
  250. RETURN
  251. ENDIF
  252.  
  253. TYPE='LISTMOTS'
  254. CALL LIROBJ(TYPE,MLMOT4,1,IRET)
  255. IF(IRET.EQ.0)THEN
  256. C On ne trouve pas d'objet de type %m1:8
  257. MOTERR( 1: 8) = 'LISTMOTS'
  258. WRITE(IOIMP,*)'Operateur : ',NOMPER
  259. CALL ERREUR(37)
  260. RETURN
  261. ENDIF
  262.  
  263. SEGACT MLMOT3,MLMOT4
  264. NINKO=MLMOT3.MOTS(/2)
  265. c write(6,*)'MLMOT3=',MLMOT3.MOTS(1),MLMOT3.MOTS(/2)
  266. c write(6,*)'MLMOT4=',MLMOT4.MOTS(1),MLMOT4.MOTS(/2)
  267.  
  268. IHV=-1
  269. IF(MLMOT4.MOTS(1)(1:4).EQ.'PRES')IHV=0
  270. IF(MLMOT4.MOTS(1)(1:4).EQ.'TEMP')IHV=0
  271. IF(MLMOT4.MOTS(1)(1:4).EQ.'VITE')IHV=1
  272. INCOD=MLMOT4.MOTS(1)
  273. IF(NINKO.EQ.2)INCOD=MLMOT4.MOTS(2)
  274. IF(IHV.EQ.-1)THEN
  275. C Le type d'inconnue %m1:8 ne convient pas.
  276. MOTERR( 1: 8) = MLMOT4.MOTS(1)
  277. WRITE(IOIMP,*)'Operateur : ',NOMPER
  278. CALL ERREUR(927)
  279. RETURN
  280. ENDIF
  281.  
  282. IHP=0
  283.  
  284. IF(IHV.EQ.0.AND.NINKO.NE.1)THEN
  285. C% Le nombre d'inconnue %i1 ne convient pas.
  286. INTERR(1) = NINKO
  287. WRITE(IOIMP,*)'Operateur : ',NOMPER
  288. CALL ERREUR(928)
  289. RETURN
  290. ENDIF
  291.  
  292. IF (TKBBT) THEN
  293. IF (NINKO.NE.2) THEN
  294. C% Le nombre d'inconnues %i1 ne convient pas.
  295. INTERR(1) = NINKO
  296. WRITE(IOIMP,*)'Operateur : ',NOMPER
  297. CALL ERREUR(928)
  298. RETURN
  299. ENDIF
  300. IF ((MLMOT4.MOTS(1).NE.'VITESSE').OR.
  301. & (MLMOT4.MOTS(2).NE.'PRESSION')) THEN
  302. C% Les types d'inconnue ne conviennent pas %m1:8 %m9:16 %m17:24 .
  303. MOTERR( 1: 8) = MLMOT4.MOTS(1)
  304. MOTERR( 9:16) = MLMOT4.MOTS(2)
  305. WRITE(IOIMP,*)'Operateur : ',NOMPER
  306. CALL ERREUR(932)
  307. RETURN
  308. ENDIF
  309. ENDIF
  310.  
  311. DO 48 N=1,NINKO
  312. NOMI(N)=MLMOT3.MOTS(N)
  313. NOMA(N)=MLMOT3.MOTS(N)
  314. 48 CONTINUE
  315.  
  316. SEGDES MLMOT3,MLMOT4
  317. c write(6,*)' INCOD=',INCOD
  318.  
  319. C*****************************************************************************
  320. C OPTIONS
  321.  
  322. IKOMP=0
  323. IAXI=0
  324. IF(IFOMOD.EQ.0)IAXI=2
  325. DEUPI=1.D0
  326. IF(IAXI.NE.0)DEUPI=2.D0*XPI
  327.  
  328. C Initialisation par defaut de quelques options
  329. CSTAB=1.D-2
  330. MPRE ='????????'
  331. XCONS=.FALSE.
  332. XRIG =.FALSE.
  333. XDIAG=.FALSE.
  334.  
  335. 1950 CONTINUE
  336. CALL QUETYP(TYPE,0,IRET)
  337. IF(IRET.EQ.0)THEN
  338. C% Il manque une donnée
  339. CALL ERREUR(641)
  340. RETURN
  341. ENDIF
  342. c write(6,*)' TYPE=',type
  343. IF(TYPE.NE.'MOT ')GO TO 1949
  344. CALL LIRCHA(CHAI,1,LCHAR)
  345. c write(6,*)' OPtion lue ',CHAI
  346.  
  347. IF(LCHAR.EQ.0)THEN
  348. C% Directive %m1:8 on ne trouve pas d'objet de type %m9:16 .
  349. MOTERR( 1: 8) = 'OPTION '
  350. MOTERR( 9:16) = 'MOT '
  351. WRITE(IOIMP,*)'Operateur : ',NOMPER
  352. CALL ERREUR(928)
  353. RETURN
  354. ENDIF
  355.  
  356. NOM=' '
  357. NOM(1:LCHAR)=CHAI
  358.  
  359. CALL OPTLI(IP,LSOPT,NOM,NBO)
  360. IF(IP.EQ.0)THEN
  361. C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant :
  362. C% %m9:16 %m17:24 %m25:32 %m33:40 Consulter la notice
  363. MOTERR( 1: 8) = NOM
  364. MOTERR( 9:16) = LSOPT(1)
  365. MOTERR(17:24) = LSOPT(3)
  366. MOTERR(25:32) = LSOPT(5)
  367. MOTERR(33:40) = '... etc '
  368. WRITE(IOIMP,*)'Operateur : ',NOMPER
  369. CALL ERREUR(930)
  370. RETURN
  371. ENDIF
  372.  
  373. GO TO (1951,1952,1953,1954,1955,1956,1957,1958,1959,1960,
  374. & 1961,1962,1963,1964,1965,1966,1967,1968,1969,1970,
  375. & 1971,1972,1973,1974),IP
  376.  
  377. C LINE
  378. 1951 CONTINUE
  379. INEFMD=1
  380. GO TO 1950
  381.  
  382. C MACRO
  383. 1952 CONTINUE
  384. INEFMD=2
  385. GO TO 1950
  386.  
  387. C QUAF
  388. 1953 CONTINUE
  389. INEFMD=3
  390. GO TO 1950
  391.  
  392. C LINB
  393. 1954 CONTINUE
  394. INEFMD=4
  395. GO TO 1950
  396.  
  397. C ISOQ
  398. 1955 CONTINUE
  399. INEFMD=5
  400. GO TO 1950
  401.  
  402. C MMDIAGO
  403. 1956 CONTINUE
  404. XDIAG=.TRUE.
  405. GO TO 1950
  406.  
  407. C RGDT
  408. 1957 CONTINUE
  409. XRIG=.TRUE.
  410. c write(6,*)' XRIG=',XRIG
  411. GO TO 1950
  412.  
  413. C CONS
  414. 1958 CONTINUE
  415. XCONS=.TRUE.
  416. GO TO 1950
  417.  
  418. C TRANS
  419. 1959 CONTINUE
  420. TTRAN=.TRUE.
  421. GO TO 1949
  422.  
  423. C PERM
  424. 1960 CONTINUE
  425. TTRAN=.FALSE.
  426. TDFDT=.FALSE.
  427. IF(NOMPER.EQ.'DFDT')THEN
  428. C% L'operateur %m1:8 ne peut etre appele dans un algorithme Permanent
  429. MOTERR( 1: 8) = NOMPER
  430. CALL ERREUR(936)
  431. RETURN
  432. ENDIF
  433. GO TO 1949
  434.  
  435. C PROJ
  436. 1961 CONTINUE
  437. TPROJ=.TRUE.
  438. TTRAN=.TRUE.
  439. GO TO 1949
  440.  
  441. C STABP
  442. 1962 CONTINUE
  443. CALL LIRREE(CSTAB,1,IRET)
  444. IF(IRET.EQ.0)THEN
  445. C On ne trouve pas d'objet de type %m1:8
  446. MOTERR( 1: 8) = 'FLOTTANT'
  447. WRITE(IOIMP,*)'Operateur : ',NOMPER
  448. CALL ERREUR(37)
  449. RETURN
  450. ENDIF
  451. GO TO 1950
  452.  
  453. C Emplacements libres
  454. 1963 CONTINUE
  455. 1964 CONTINUE
  456. GO TO 1950
  457.  
  458. C CENTRE
  459. 1965 CONTINUE
  460. C CENTREP0
  461. 1966 CONTINUE
  462. C CENTREP1
  463. 1967 CONTINUE
  464. C MSOMMET
  465. 1968 CONTINUE
  466. MPRE=LSOPT(IP)
  467. GO TO 1950
  468.  
  469. C Emplacements libres
  470. 1969 CONTINUE
  471. 1970 CONTINUE
  472. GO TO 1950
  473.  
  474. C CMD
  475. 1971 CONTINUE
  476. CALL LIRREE(CMD,1,IRET)
  477. IF(IRET.EQ.0)THEN
  478. C On ne trouve pas d'objet de type %m1:8
  479. MOTERR( 1: 8) = 'FLOTTANT'
  480. WRITE(IOIMP,*)'Operateur : ',NOMPER
  481. CALL ERREUR(37)
  482. RETURN
  483. ENDIF
  484. GO TO 1950
  485.  
  486. C IDCEN 1-> CENTREE 2-> SUPGDC 3-> SUPG 4-> TVISQUEU 5-> CNG
  487. C CENTREE
  488. 1972 CONTINUE
  489. IDCEN=1
  490. c write(6,*)'LSOPT 1972 ',LSOPT(IP),IP,' IDCEN=',IDCEN
  491. GO TO 1950
  492.  
  493. C SUPGDC
  494. 1973 CONTINUE
  495. IDCEN=2
  496. c write(6,*)'LSOPT 1973 ',LSOPT(IP),IP,' IDCEN=',IDCEN
  497. GO TO 1950
  498.  
  499. C SUPG
  500. 1974 CONTINUE
  501. IDCEN=3
  502. c write(6,*)'LSOPT 1974 ',LSOPT(IP),IP,' IDCEN=',IDCEN
  503. GO TO 1950
  504.  
  505.  
  506. C*********** Fin Lecture des options ***********************************
  507.  
  508. 1949 CONTINUE
  509.  
  510. IF(TKBBT.AND.MPRE.EQ.'????????')THEN
  511. C% L'option %m1:8 n'a pas ete defini, elle est necessaire dans ce contexte.
  512. MOTERR( 1: 8) = 'Pression'
  513. CALL ERREUR(934)
  514. RETURN
  515. ENDIF
  516.  
  517.  
  518. IF(XRIG)THEN
  519. IF(IHV.EQ.0)THEN
  520. NOMP(1)='T '
  521. NOMD(1)='Q '
  522. ELSEIF(IHV.EQ.1)THEN
  523. NOMP(1)='UX '
  524. NOMP(2)='UY '
  525. NOMP(3)='UZ '
  526. NOMD(1)='FX '
  527. NOMD(2)='FY '
  528. NOMD(3)='FZ '
  529. ENDIF
  530. ELSE
  531. IF(IHV.EQ.0)THEN
  532. NOMP(1)=NOMI(1)
  533. NOMD(1)=NOMI(1)
  534. ELSEIF(IHV.EQ.1)THEN
  535. WRITE(NOMP(1),FMT='(I1,A3)')1,NOMI(1)(1:3)
  536. WRITE(NOMD(1),FMT='(I1,A3)')1,NOMI(1)(1:3)
  537. WRITE(NOMP(2),FMT='(I1,A3)')2,NOMI(1)(1:3)
  538. WRITE(NOMD(2),FMT='(I1,A3)')2,NOMI(1)(1:3)
  539. WRITE(NOMP(3),FMT='(I1,A3)')3,NOMI(1)(1:3)
  540. WRITE(NOMD(3),FMT='(I1,A3)')3,NOMI(1)(1:3)
  541. IF(TVITP)THEN
  542. DO 1948 I=1,IDIM
  543. NOMD(I)=NOMI(2)(1:4)
  544. 1948 CONTINUE
  545. ENDIF
  546. ENDIF
  547. ENDIF
  548. c write(6,*)' NOMP=',nomp
  549. c write(6,*)' NOMD=',nomd
  550.  
  551.  
  552. c write(6,*)'DECENTREMENT',IDCEN,CMD
  553.  
  554. AIMPL=1.D0
  555.  
  556. CMT=CMD
  557. XPG=.FALSE.
  558. XTG=.FALSE.
  559. XTV=.FALSE.
  560. XBDF=.FALSE.
  561. C***********************************************************************
  562. C*************** Lecture des caracteristiques du schema en temps *******
  563. C***********************************************************************
  564.  
  565. c write(6,*)' TTRAN,TPROJ=',TTRAN,TPROJ
  566. IF(TTRAN)THEN
  567.  
  568. C On lit le pas de temps
  569. c write(6,*)'On lit le pas de temps'
  570. CALL LIRREE(DELTAT,1,IRET)
  571. IF(IRET.EQ.0)THEN
  572. C On ne trouve pas d'objet de type %m1:8
  573. MOTERR( 1: 8) = 'FLOTTANT'
  574. WRITE(IOIMP,*)'Operateur : ',NOMPER
  575. CALL ERREUR(37)
  576. RETURN
  577. ENDIF
  578.  
  579. C On lit le schema en temps
  580. c write(6,*)'On lit le schema en temps '
  581. CALL LIRCHA(SCHT,1,LCHAR)
  582. IF(LCHAR.EQ.0)THEN
  583. C On ne trouve pas d'objet de type %m1:8
  584. MOTERR( 1: 8) = 'MOT '
  585. WRITE(IOIMP,*)'Operateur : ',NOMPER
  586. CALL ERREUR(37)
  587. RETURN
  588. ENDIF
  589. c write(6,*)'SCHEMA en TEMPS ',SCHT
  590. CALL OPTLI(IPST,LSCHE,SCHT,NBH)
  591. IF(IPST.EQ.0)THEN
  592. C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant :
  593. C% %m9:16 %m17:24 %m25:32 %m33:40 Consulter la notice
  594. MOTERR( 1: 8) = 'SCHT '
  595. MOTERR( 9:16) = LSCHE(2)
  596. MOTERR(17:24) = LSCHE(4)
  597. MOTERR(25:32) = LSCHE(7)
  598. MOTERR(33:40) = '... etc '
  599. WRITE(IOIMP,*)'Operateur : ',NOMPER
  600. CALL ERREUR(930)
  601. RETURN
  602. ENDIF
  603.  
  604. IF(SCHT.EQ.'SEMI')THEN
  605. CALL LIRREE(XVAL,1,IRET)
  606. IF(IRET.EQ.0)THEN
  607. C On ne trouve pas d'objet de type %m1:8
  608. MOTERR( 1: 8) = 'FLOTTANT'
  609. WRITE(IOIMP,*)'Operateur : ',NOMPER
  610. CALL ERREUR(37)
  611. RETURN
  612. ENDIF
  613. AIMPL=XVAL
  614. ENDIF
  615.  
  616. IF(SCHT.EQ.'EUL_EXPL')AIMPL=0.D0
  617. IF(SCHT.EQ.'EUL_IMPL')AIMPL=1.D0
  618. IF(SCHT.EQ.'CN ')AIMPL=0.5D0
  619.  
  620. IF(SCHT.EQ.'EUL_EXPL'.OR.
  621. & SCHT.EQ.'EUL_IMPL'.OR.
  622. & SCHT.EQ.'CN '.OR.
  623. & SCHT.EQ.'BDF2 '.OR.
  624. & SCHT.EQ.'SEMI ')XPG=.TRUE.
  625. IF(.NOT.TCONV)XPG=.FALSE.
  626.  
  627. IF(XPG.AND.IDCEN.NE.1.AND.IDCEN.NE.2.AND.IDCEN.NE.3)THEN
  628. C% L'option PETROV-GALERKIN est incompatible ce schema en temps
  629. CALL ERREUR (937)
  630. RETURN
  631. ENDIF
  632.  
  633. IF(.NOT.TCONV)IDCEN=1
  634.  
  635. IF(SCHT.EQ.'BDF2 ')THEN
  636. AIMPL=1.D0
  637. XBDF=.TRUE.
  638. CMT=CMD
  639. ENDIF
  640.  
  641. IF(SCHT.EQ.'CNG ')THEN
  642. AIMPL=0.5D0
  643. XTG=.TRUE.
  644. CMT=DELTAT
  645. ENDIF
  646.  
  647. IF(SCHT.EQ.'TVISQ')THEN
  648. AIMPL=0.5D0
  649. XTV=.TRUE.
  650. CMT=DELTAT
  651. ENDIF
  652. ENDIF
  653.  
  654. C*********** Fin Lecture des caracteristiques du schema en temps *******
  655.  
  656. c write(6,*)'TCLSF appele par ',NOMPER,' AIMPL=',AIMPL,' IHV=',IHV
  657. c write(6,*)'XBDF =',XBDF
  658. c write(6,*)' TLAPN=',TLAPN,' TTRAN=',TTRAN,' TCONV=',TCONV
  659. c write(6,*)' TSOUR=',TSOUR,' TMASS=',TMASS,' TECHI=',TECHI
  660. c write(6,*)' TMDIA=',TMDIA,' XDIAG=',XDIAG,' TKBBT=',TKBBT
  661.  
  662. C*****************************************************************************
  663. C
  664. CALL MEKTAB(MTABZ,INEFMD,'MAILLAGE',MELEME)
  665. IF(TKBBT.AND.(MPRE.NE.'CENTRE').AND.(INEFMD.EQ.2))THEN
  666. CALL MEKTAB(MTABZ,INEFMD,'MACRO1',MELEME)
  667. ENDIF
  668.  
  669. CALL MEKTAB(MTABZ,INEFMD,'SOMMET',MELEMS)
  670. IF(MPRE.NE.'????????')THEN
  671. CALL MEKTAB(MTABZ,INEFMD,MPRE,MELEMP)
  672. ENDIF
  673. CALL MEKTAB(MTABZ,INEFMD,'CENTRE',MELEMC)
  674. IF (IERR.NE.0) RETURN
  675.  
  676. c write(6,*)'INCOD=',INCOD,' MPRE=',MPRE
  677. IF(INCOD.EQ.'VITE'.OR.INCOD.EQ.'TEMP')THEN
  678. MELEM2=MELEME
  679. ELSE
  680. IF(MPRE.EQ.'CENTREP1')CALL MEKTAB(MTABZ,INEFMD,'ELTP1NC ',MELEM2)
  681. IF(MPRE.EQ.'MSOMMET ')CALL MEKTAB(MTABZ,INEFMD,'MMAIL ',MELEM2)
  682. IF(MPRE.EQ.'CENTRE ')CALL MEKTAB(MTABZ,INEFMD,'CENTRE ',MELEM2)
  683. IF(MPRE.EQ.'CENTREP0')CALL MEKTAB(MTABZ,INEFMD,'CENTREP0',MELEM2)
  684.  
  685. C /S INEFMD : Type formulation
  686. C INEFMD = 1 LINE,
  687. C = 2 MACRO,
  688. C = 3 QUADRATIQUE,
  689. C = 4 LINB,
  690. C = 5 ISOQ.
  691. NOM0='????????'
  692. IF(INEFMD.EQ.1)THEN
  693. IF(MPRE.EQ.'CENTRE ')NOM0='OK'
  694. IF(MPRE.EQ.'MSOMMET ')NOM0='OK'
  695. ELSEIF(INEFMD.EQ.2)THEN
  696. IF(MPRE.EQ.'CENTRE ')NOM0='OK'
  697. c ces elements ne marchent pas
  698. IF(MPRE.EQ.'CENTREP0')NOM0='OK'
  699. IF(MPRE.EQ.'CENTREP1')NOM0='OK'
  700. IF(MPRE.EQ.'MSOMMET ')NOM0='OK'
  701. ELSEIF(INEFMD.EQ.3)THEN
  702. IF(MPRE.EQ.'CENTREP0')NOM0='OK'
  703. IF(MPRE.EQ.'CENTREP1')NOM0='OK'
  704. IF(MPRE.EQ.'MSOMMET ')NOM0='OK'
  705. ELSEIF(INEFMD.EQ.4)THEN
  706. IF(MPRE.EQ.'MSOMMET ')NOM0='OK'
  707. ENDIF
  708. IF(NOM0.EQ.'????????')THEN
  709. C% Le type d'element fini Vitesse/pression ne convient pas : %m1:8 %m9:16 .
  710. MOTERR( 1: 8) =LSOPT(INEFMD)
  711. MOTERR( 9:16) =MPRE
  712. WRITE(IOIMP,*)'Operateur : ',NOMPER
  713. CALL ERREUR(933)
  714. RETURN
  715. ENDIF
  716.  
  717. ENDIF
  718.  
  719. C*************************************************************************
  720.  
  721. SEGACT MELEME,MELEM2
  722. c write(6,*)'MELEME=',MELEME,'MELEM2=',MELEM2
  723. SEGDES MTABZ
  724.  
  725. C*************************************************************************
  726. C Lecture des Inco(s) aux temps precedents si Transitoire
  727. C Lecture des Inco(s) a l'iteration precedente si Permanent
  728. c write(6,*)' Lecture des Inco(s)'
  729.  
  730. CALL QUETYP(TYPE,0,IRET)
  731. IF(IRET.EQ.0)THEN
  732. C% Il manque une donnée
  733. CALL ERREUR(641)
  734. RETURN
  735. ENDIF
  736.  
  737. TLINCO=.FALSE.
  738. IF(IDCEN.EQ.2)TLINCO=.TRUE.
  739. IF(TYPE.EQ.'MOT ')THEN
  740. TLINCO=.TRUE.
  741. CALL LIRCHA(CHAI,1,LCHAR)
  742. IF(CHAI.NE.'INCO') THEN
  743. C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant :
  744. C% %m9:16 %m17:24 %m25:32 %m33:40 Consulter la notice
  745. MOTERR( 1: 8) = CHAI
  746. MOTERR( 9:16) = 'INCO'
  747. MOTERR(17:24) = ' '
  748. MOTERR(25:32) = ' '
  749. MOTERR(33:40) = ' '
  750. WRITE(IOIMP,*)'Operateur : ',NOMPER
  751. CALL ERREUR(930)
  752. RETURN
  753. ENDIF
  754. ENDIF
  755. IF(.NOT.TLINCO.AND.TTRAN)THEN
  756. C% Opération illicite dans ce contexte
  757. WRITE(IOIMP,*)'Operateur : ',NOMPER,' On attend des inconnues'
  758. CALL ERREUR(153)
  759. RETURN
  760. ENDIF
  761.  
  762. C 1ere inconnue
  763. IF(NINKO.GE.1.AND.TLINCO)THEN
  764. TYPE='CHPOINT'
  765. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  766.  
  767. IF(IRET.EQ.0)THEN
  768. C% Rubrique %m1:8 on ne trouve pas d'objet de type %m9:16 .
  769. MOTERR( 1: 8) = 'INCO '
  770. MOTERR( 9:16) = 'CHPOINT '
  771. WRITE(IOIMP,*)'Operateur : ',NOMPER
  772. CALL ERREUR(929)
  773. RETURN
  774. ENDIF
  775.  
  776. CALL LRCHT(MCHPOI,MTETA1,TYPE,IGEOM)
  777. MTETA2=MTETA1
  778. CALL KRIPAD(IGEOM,MLENT1)
  779. CALL VERPAD(MLENT1,MELEMS,IRET)
  780. IF(IRET.NE.0)THEN
  781. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  782. MOTERR(1: 8) = 'TETA1'
  783. MOTERR(9:16) = 'CHPOINT '
  784. WRITE(IOIMP,*)'Operateur : ',NOMPER
  785. CALL ERREUR(788)
  786. RETURN
  787. ENDIF
  788.  
  789. NC=MTETA1.VPOCHA(/2)
  790.  
  791. IF((IHV.EQ.0.AND.NC.NE.1).OR.
  792. & (IHV.EQ.1.AND.NC.NE.IDIM))THEN
  793. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon nombre de composantes
  794. MOTERR( 1: 8) = 'Inconnue'
  795. MOTERR( 9:16) = 'CHPOINT'
  796. WRITE(IOIMP,*)'Operateur : ',NOMPER
  797. CALL ERREUR(784)
  798. RETURN
  799. ENDIF
  800.  
  801. SEGDES IGEOM,MELEMS
  802.  
  803. IF(XBDF)THEN
  804. TYPE='CHPOINT'
  805. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  806.  
  807. IF(IRET.EQ.0)THEN
  808. C% On ne trouve pas d'objet de type %m1:8
  809. MOTERR( 1: 8) = 'CHPOINT '
  810. WRITE(IOIMP,*)'Operateur : ',NOMPER
  811. CALL ERREUR(37)
  812. RETURN
  813. ENDIF
  814.  
  815. CALL LRCHT(MCHPOI,MTETA2,TYPE,IGEOM)
  816. CALL KRIPAD(IGEOM,MLENT2)
  817. CALL VERPAD(MLENT2,MELEMS,IRET)
  818. IF(IRET.NE.0)THEN
  819. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  820. MOTERR(1: 8) = 'TETA2'
  821. MOTERR(9:16) = 'CHPOINT '
  822. WRITE(IOIMP,*)'Operateur : ',NOMPER
  823. CALL ERREUR(788)
  824. RETURN
  825. ENDIF
  826.  
  827. NC=MTETA2.VPOCHA(/2)
  828.  
  829. IF((IHV.EQ.0.AND.NC.NE.1).OR.
  830. & (IHV.EQ.1.AND.NC.NE.IDIM))THEN
  831. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon nombre de composantes
  832. MOTERR( 1: 8) = 'Inconnue'
  833. MOTERR( 9:16) = 'CHPOINT'
  834. WRITE(IOIMP,*)'Operateur : ',NOMPER
  835. CALL ERREUR(785)
  836. RETURN
  837. ENDIF
  838.  
  839. SEGDES IGEOM,MELEMS
  840.  
  841. ENDIF
  842. ENDIF
  843.  
  844. C 2eme inconnue
  845. IF(NINKO.GE.2.AND.TLINCO)THEN
  846. TYPE='CHPOINT'
  847. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  848.  
  849. IF(IRET.EQ.0)THEN
  850. C% Rubrique %m1:8 on ne trouve pas d'objet de type %m9:16 .
  851. MOTERR( 1: 8) = 'INCO2 '
  852. MOTERR( 9:16) = 'CHPOINT '
  853. WRITE(IOIMP,*)'Operateur : ',NOMPER
  854. CALL ERREUR(929)
  855. RETURN
  856. ENDIF
  857.  
  858. CALL LRCHT(MCHPOI,MTETA3,TYPE,IGEOM)
  859. MTETA4=MTETA3
  860. CALL KRIPAD(IGEOM,MLENT3)
  861. IRET=0
  862. IF(.NOT.TVNIP)CALL VERPAD(MLENT3,MELEMP,IRET)
  863. IF(IRET.NE.0)THEN
  864. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  865. MOTERR(1: 8) = 'TETA3'
  866. MOTERR(9:16) = 'CHPOINT '
  867. WRITE(IOIMP,*)'Operateur : ',NOMPER
  868. CALL ERREUR(788)
  869. RETURN
  870. ENDIF
  871.  
  872. NC=MTETA3.VPOCHA(/2)
  873.  
  874. IF(IHP.EQ.0.AND.NC.NE.1)THEN
  875. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon nombre de composantes
  876. MOTERR( 1: 8) = 'Inconnue'
  877. MOTERR( 9:16) = 'CHPOINT'
  878. WRITE(IOIMP,*)'Operateur : ',NOMPER
  879. CALL ERREUR(784)
  880. RETURN
  881. ENDIF
  882.  
  883. SEGDES IGEOM,MELEMP
  884.  
  885. IF(XBDF)THEN
  886. TYPE='CHPOINT'
  887. CALL LIROBJ(TYPE,MCHPOI,1,IRET)
  888.  
  889. IF(IRET.EQ.0)THEN
  890. C% On ne trouve pas d'objet de type %m1:8
  891. MOTERR( 1: 8) = 'CHPOINT '
  892. WRITE(IOIMP,*)'Operateur : ',NOMPER
  893. CALL ERREUR(37)
  894. RETURN
  895. ENDIF
  896.  
  897. CALL LRCHT(MCHPOI,MTETA4,TYPE,IGEOM)
  898. CALL KRIPAD(IGEOM,MLENT4)
  899. IRET=0
  900. IF(.NOT.TVNIP)CALL VERPAD(MLENT4,MELEMP,IRET)
  901. IF(IRET.NE.0)THEN
  902. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  903. MOTERR(1: 8) = 'TETA4'
  904. MOTERR(9:16) = 'CHPOINT '
  905. WRITE(IOIMP,*)'Operateur : ',NOMPER
  906. CALL ERREUR(788)
  907. RETURN
  908. ENDIF
  909.  
  910. NC=MTETA4.VPOCHA(/2)
  911.  
  912. IF(IHP.EQ.0.AND.NC.NE.1)THEN
  913. C% Indice %m1:8 : L'objet %m9:16 n'a pas le bon nombre de composantes
  914. MOTERR( 1: 8) = 'Inconnue'
  915. MOTERR( 9:16) = 'CHPOINT'
  916. WRITE(IOIMP,*)'Operateur : ',NOMPER
  917. CALL ERREUR(785)
  918. RETURN
  919. ENDIF
  920.  
  921. SEGDES IGEOM,MELEMP
  922.  
  923. ENDIF
  924. ENDIF
  925. C On cree un second membre non vide
  926. SEGACT MELEMS
  927. N=MELEMS.NUM(/2)
  928. IF(IHV.EQ.0)NC=1
  929. IF(IHV.EQ.1)NC=IDIM
  930. IF(TVITP)NC=1
  931. SEGDES MELEMS
  932. NSOUPO=1
  933. NAT=2
  934. SEGINI MCHPO1,MSOUP1,MPOVA1
  935. MCHPO1.JATTRI(1)=2
  936. MCHPO1.IFOPOI=IFOMOD
  937. MCHPO1.MTYPOI=' '
  938. MCHPO1.MOCHDE=' '
  939. MCHPO1.IPCHP(1)=MSOUP1
  940. MSOUP1.IGEOC=MELEMS
  941. MSOUP1.IPOVAL=MPOVA1
  942. IF(IHV.EQ.0.OR.TVITP)THEN
  943. MSOUP1.NOCOMP(1)=NOMD(1)
  944. ELSE
  945. DO 91 N=1,NC
  946. MSOUP1.NOCOMP(N)=NOMD(N)
  947. 91 CONTINUE
  948. ENDIF
  949. SEGDES MSOUP1,MCHPO1
  950.  
  951. C*****************************************************************************
  952. C Lecture du coefficient
  953.  
  954. CALL LIRENT(IARG,1,IRET)
  955.  
  956. IF(IRET.EQ.0)THEN
  957. WRITE(IOIMP,*)'Operateur : ',NOMPER
  958. CALL ERREUR(766)
  959. RETURN
  960. ENDIF
  961. c write(6,*)' IARG=',iarg,' TDFDT=',TDFDT
  962.  
  963. CALL INITI(ICOEF,4,0)
  964. IF(TDFDT)ICOEF(1)=1
  965. IF(TMASS)ICOEF(1)=1
  966. IF(TCONV)THEN
  967. ICOEF(1)=1
  968. ICOEF(2)=1
  969. ENDIF
  970. IF(TLAPN)ICOEF(3)=1
  971. IF(TSOUR)ICOEF(4)=1
  972. IF(TKBBT)ICOEF(1)=1
  973. ICT=ICOEF(1)+ICOEF(2)+ICOEF(3)+ICOEF(4)
  974. IF(ICT.NE.IARG)THEN
  975. C% Données incompatibles
  976. WRITE(6,*)'Nombre d arguments incorrect'
  977. WRITE(IOIMP,*)'Operateur : ',NOMPER
  978. CALL ERREUR(22)
  979. RETURN
  980. ENDIF
  981.  
  982. NUCOEF=0
  983.  
  984. IF(TDFDT.OR.TMASS.OR.TCONV)THEN
  985. NUCOEF=NUCOEF+1
  986. CALL LEKMIF(NUCOEF,MTABZ,0,MCHEL1,KPOIND)
  987. IF (IERR.NE.0) RETURN
  988. ENDIF
  989.  
  990. c write(6,*)' Avt TLAPN LEKMIF '
  991. IF(TLAPN)THEN
  992. NUCOEF=NUCOEF+1
  993. CALL LEKMIF(NUCOEF,MTABZ,0,MCHEL2,KPOIND)
  994. IF (IERR.NE.0) RETURN
  995. ELSEIF(TCONV)THEN
  996. c write(6,*)'Cas decentrement'
  997. SEGACT MELEME
  998. L1=72
  999. N1=MAX(1,LISOUS(/1))
  1000. N2=1
  1001. N3=6
  1002. SEGINI MCHEL2
  1003. SEGACT MCHEL1
  1004. DO 71 L=1,N1
  1005. MCHAM1=MCHEL1.ICHAML(L)
  1006. SEGACT MCHAM1
  1007. MELVA1=MCHAM1.IELVAL(1)
  1008. SEGACT MELVA1
  1009. N1PTEL=MELVA1.VELCHE(/1)
  1010. N1EL=1
  1011. N2PTEL=0
  1012. N2EL=0
  1013. c fauteDO 71 L=1,N1
  1014. SEGINI MCHAM2,MELVA2
  1015. MCHEL2.ICHAML(L)=MCHAM2
  1016. MCHAM2.IELVAL(1)=MELVA2
  1017. DO 72 LG=1,N1PTEL
  1018. MELVA2.VELCHE(LG,1)=1.D-30
  1019. 72 CONTINUE
  1020. 71 CONTINUE
  1021. ENDIF
  1022.  
  1023. c write(6,*)' Avt TCONV LEKMIF XPG,XTV,XTG,N.TDFDT=',
  1024. c & XPG,XTV,XTG,(.NOT.TDFDT)
  1025. IF(TCONV)THEN
  1026. c? IF(XPG)THEN
  1027. NUCOEF=NUCOEF+1
  1028. CALL LEKMIF(NUCOEF,MTABZ,1,MCHEL3,KPOIND)
  1029. IF (IERR.NE.0) RETURN
  1030. c? ELSEIF(XTV)THEN
  1031. c? NUCOEF=NUCOEF+1
  1032. c? CALL LEKMIF(NUCOEF,MTABZ,1,MCHEL3,KPOIND)
  1033. c? & 4 ,DELTAT,MCHEL1,MCHEL1)
  1034. c? IF (IERR.NE.0) RETURN
  1035. c? ELSEIF(XTG)THEN
  1036. c? NUCOEF=NUCOEF+1
  1037. c? CALL LEKMIF(NUCOEF,MTABZ,1,MCHEL3,KPOIND)
  1038. c? & 5 ,DELTAT,MCHEL1,MCHEL1)
  1039. c? IF (IERR.NE.0) RETURN
  1040. C ELSEIF(.NOT.TDFDT)THEN
  1041. c? ELSE
  1042. c write(6,*)' On est bien ds ce cas'
  1043. c? NUCOEF=NUCOEF+1
  1044. c? CALL LEKMIF(NUCOEF,MTABZ,1,MCHEL3,KPOIND)
  1045. c? IF (IERR.NE.0) RETURN
  1046. c? ENDIF
  1047. ENDIF
  1048.  
  1049. c write(6,*)' Avt LEKMIF TSOUR'
  1050. IF(TSOUR)THEN
  1051. NUCOEF=NUCOEF+1
  1052. CALL LEKMIF(NUCOEF,MTABZ,IHV,MCHEL4,KPOIND)
  1053. c write(6,*)' Apr LEKMIF TSOUR'
  1054. IF (IERR.NE.0) RETURN
  1055. ENDIF
  1056.  
  1057. IF(TKBBT.OR.TVNIP)THEN
  1058. NUCOEF=NUCOEF+1
  1059. CALL LEKMIF(NUCOEF,MTABZ,0,MCHEL1,KPOIND)
  1060. c write(6,*)' meleme,melem2=',meleme,melem2
  1061. IF (IERR.NE.0) RETURN
  1062. ENDIF
  1063.  
  1064. C*************************************************************************
  1065. C******* CALCUL **********************************************************
  1066. C*************************************************************************
  1067.  
  1068. C Initialisation RIGIDITE Vide
  1069. IF(XRIG)THEN
  1070. NRIGE=8
  1071. NRIGEL=0
  1072. SEGINI MRIGID
  1073.  
  1074. ELSE
  1075. C Initialisation MATRIK Vide
  1076. NRIGE=7
  1077. NKID =9
  1078. NKMT =7
  1079. NMATRI=0
  1080. SEGINI MATRIK
  1081. ENDIF
  1082. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1083. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1084. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1085. IF(.NOT.TVITP)THEN
  1086.  
  1087. CALL KRIPAD(MELEMS,MLENTI)
  1088. SEGDES MELEMS
  1089.  
  1090. NUTOEL=0
  1091. SEGACT MELEME,MELEM2
  1092. NBSOUS=LISOUS(/1)
  1093. IF(NBSOUS.EQ.0)NBSOUS=1
  1094.  
  1095. IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN)THEN
  1096. C Cas RIGIDITE
  1097. IF(XRIG)THEN
  1098. NRIGE=8
  1099. NRI=IRIGEL(/2)
  1100. NRIGEL=NBSOUS+NRI
  1101. SEGADJ MRIGID
  1102. c write(6,*)' NRIGE,NRIGEL,MRIGID=',NRIGE,NRIGEL,MRIGID
  1103.  
  1104. ELSE
  1105. C Cas MATRIK Pleine
  1106. NRIGE=7
  1107. NKID =9
  1108. NKMT =7
  1109. NMATR0=JRIGEL(/2)
  1110.  
  1111. NBME=1
  1112. IF(IHV.EQ.1)NBME=IDIM
  1113. NMATRI=NMATR0+NBME
  1114. SEGADJ MATRIK
  1115.  
  1116. DO 41 M=1,NBME
  1117. JRIGEL(1,NMATR0+M)=MELEME
  1118. JRIGEL(2,NMATR0+M)=MELEM2
  1119. JRIGEL(7,NMATR0+M)=0
  1120. IF(TCONV)JRIGEL(7,NMATR0+M)=2
  1121. SEGINI JMATRI
  1122. JRIGEL(4,NMATR0+M)=JMATRI
  1123. KSPGP=MELEMS
  1124. KSPGD=MELEMS
  1125. LISPRI(1)=NOMP(M)//' '
  1126. LJSDUA(1)=NOMD(M)//' '
  1127. 41 CONTINUE
  1128. ENDIF
  1129. ENDIF
  1130.  
  1131. IF(TDFDT.OR.TMASS.OR.TCONV)SEGACT MCHEL1
  1132. IF(TLAPN)SEGACT MCHEL2
  1133. IF(TCONV)SEGACT MCHEL3
  1134. IF(TSOUR)SEGACT MCHEL4
  1135. IF(TLINCO)THEN
  1136. SEGACT MTETA1
  1137. IF(XBDF)SEGACT MTETA2
  1138. ENDIF
  1139.  
  1140. IF(MAX(1,MELEM2.LISOUS(/1)).NE.MAX(1,LISOUS(/1)))THEN
  1141. WRITE(6,*)' Geometries incompatibles dans ',nomper
  1142. C% Données incompatibles
  1143. CALL ERREUR(22)
  1144. RETURN
  1145. ENDIF
  1146.  
  1147. DO 101 L=1,MAX(1,LISOUS(/1))
  1148. IPT1=MELEME
  1149. IPT2=MELEM2
  1150. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  1151. IF(MELEM2.LISOUS(/1).NE.0)IPT2=MELEM2.LISOUS(L)
  1152. SEGACT IPT1,IPT2
  1153.  
  1154. NOM0 = NOMS(IPT1.ITYPEL)//' '
  1155. c write(6,*)' 1er KALPBG NOM0=',NOM0,IPT1
  1156. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  1157. IF(IZFFM.EQ.0)RETURN
  1158. SEGACT IZFFM*MOD
  1159. IZHR=KZHR(1)
  1160. SEGACT IZHR*MOD
  1161. IZF1 = KTP(1)
  1162. IZH2 = KZHR(2)
  1163. IZW = IZFFM
  1164. IZWH = IZHR
  1165.  
  1166. IF(INCOD.EQ.'PRES')THEN
  1167. IZW = IZF1
  1168. IZWH = IZH2
  1169. IF(IPT2.NUM(/1).NE.IZF1.FN(/1))THEN
  1170. * Le type d'élément fini ne convient pas
  1171. MOTERR( 1: 8) =' '
  1172. WRITE(IOIMP,*)'Operateur : ',NOMPER
  1173. CALL ERREUR(926)
  1174. RETURN
  1175. ENDIF
  1176. ENDIF
  1177.  
  1178. NES=GR(/1)
  1179. NPG=GR(/3)
  1180.  
  1181. NP = IPT1.NUM(/1)
  1182. MP = IPT2.NUM(/1)
  1183. C? MP = IZW.FN(/1) ceci doit etre identique
  1184.  
  1185. NBEL=IPT1.NUM(/2)
  1186.  
  1187. SEGINI SAJT
  1188.  
  1189. IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN)THEN
  1190. C Cas RIGIDITE
  1191. IF(XRIG)THEN
  1192. IRIGEL(1,NRI+L)=MELEME
  1193. COERIG(L)=1.D0
  1194.  
  1195. IRIGEL(7,NRI+L)=0
  1196. IF(TCONV)IRIGEL(7,NRI+L)=2
  1197.  
  1198. NBME=1
  1199. IF(IHV.EQ.1)NBME=IDIM
  1200. NLIGRP=NP
  1201. NLIGRD=MP
  1202. SEGINI DESCR
  1203. IRIGEL(3,NRI+L)=DESCR
  1204. IF(NBME.EQ.1)THEN
  1205. DO 102 I=1,NLIGRP
  1206. LISINC(I)=NOMP(1)//' '
  1207. NOELEP(I)=I
  1208. 102 CONTINUE
  1209. DO 103 I=1,NLIGRD
  1210. LISDUA(I)=NOMD(1)//' '
  1211. NOELED(I)=I
  1212. 103 CONTINUE
  1213. ELSE
  1214. ENDIF
  1215. SEGDES DESCR
  1216.  
  1217. NELRIG=NBEL
  1218. SEGINI xMATRI
  1219. IRIGEL(4,NRI+L)=xMATRI
  1220. xmatri.symre=irigel(7,nri+l)
  1221. c write(6,*)'NELRIG,IMATRI=',NELRIG,IMATRI
  1222.  
  1223. * DO 104 K=1,NELRIG
  1224. * SEGINI XMATRI
  1225. c write(6,*)'NLIGRD,NLIGRP,XMATRI=',NLIGRD,NLIGRP,XMATRI
  1226. * IMATTT(K)=XMATRI
  1227. * 104 CONTINUE
  1228.  
  1229. ELSE
  1230. C Cas MATRIK
  1231. SEGINI IPM1
  1232. JMATR1=JRIGEL(4,NMATR0+1)
  1233. JMATR1.LIZAFM(L,1)=IPM1
  1234. IPM2=IPM1
  1235. IPM3=IPM1
  1236. IF(NBME.GE.2)THEN
  1237. JMATR2=JRIGEL(4,NMATR0+2)
  1238.  
  1239. IF(IAXI.NE.0)THEN
  1240. SEGINI IPM2
  1241. JMATR2.LIZAFM(L,1)=IPM2
  1242. ICAL2=.TRUE.
  1243. ELSE
  1244. IPM2=IPM1
  1245. JMATR2.LIZAFM(L,1)=IPM2
  1246. ICAL2=.FALSE.
  1247. ENDIF
  1248.  
  1249. ENDIF
  1250. IF(NBME.GE.3)THEN
  1251. JMATR3=JRIGEL(4,NMATR0+3)
  1252.  
  1253. IPM3=IPM1
  1254. JMATR3.LIZAFM(L,1)=IPM3
  1255. ICAL3=.FALSE.
  1256.  
  1257. ENDIF
  1258. ENDIF
  1259. ENDIF
  1260.  
  1261. C----Ro
  1262. IK1=1
  1263. IF(TDFDT.OR.TMASS.OR.TCONV)THEN
  1264. MCHAM1=MCHEL1.ICHAML(L)
  1265. SEGACT MCHAM1
  1266.  
  1267. MELVA1=MCHAM1.IELVAL(1)
  1268. SEGACT MELVA1
  1269. N1PTEL=MELVA1.VELCHE(/1)
  1270. N1EL=MELVA1.VELCHE(/2)
  1271. IF(N1EL.EQ.1)THEN
  1272. IK1=1
  1273. ELSEIF(N1EL.EQ.NBEL)THEN
  1274. IK1=0
  1275. ENDIF
  1276. ENDIF
  1277.  
  1278. C----Lambda
  1279. IK2=1
  1280. IF(TLAPN)THEN
  1281. MCHAM2=MCHEL2.ICHAML(L)
  1282. SEGACT MCHAM2
  1283.  
  1284. MELVA2=MCHAM2.IELVAL(1)
  1285. SEGACT MELVA2
  1286. N1PTEL=MELVA2.VELCHE(/1)
  1287. N1EL=MELVA2.VELCHE(/2)
  1288. IF(N1EL.EQ.1)THEN
  1289. IK2=1
  1290. ELSEIF(N1EL.EQ.NBEL)THEN
  1291. IK2=0
  1292. ENDIF
  1293. ENDIF
  1294.  
  1295. C----U
  1296. IK3=1
  1297. IF(TCONV)THEN
  1298. MCHAM3=MCHEL3.ICHAML(L)
  1299. SEGACT MCHAM3
  1300.  
  1301. MELVA3=MCHAM3.IELVAL(1)
  1302. SEGACT MELVA3
  1303. N1PTEL=MELVA3.VELCHE(/1)
  1304. N1EL=MELVA3.VELCHE(/2)
  1305. IF(N1EL.EQ.1)THEN
  1306. IK3=1
  1307. ELSEIF(N1EL.EQ.NBEL)THEN
  1308. IK3=0
  1309. ENDIF
  1310. ENDIF
  1311.  
  1312. C----source
  1313. IK4=1
  1314. IF(TSOUR)THEN
  1315. MCHAM4=MCHEL4.ICHAML(L)
  1316. SEGACT MCHAM4
  1317.  
  1318. MELVA4=MCHAM4.IELVAL(1)
  1319. SEGACT MELVA4
  1320. N1PTEL=MELVA4.VELCHE(/1)
  1321. N1EL=MELVA4.VELCHE(/2)
  1322. IF(N1EL.EQ.1)THEN
  1323. IK4=1
  1324. ELSEIF(N1EL.EQ.NBEL)THEN
  1325. IK4=0
  1326. ENDIF
  1327. ENDIF
  1328.  
  1329. c write(6,*)' AVANT 108 NC=',NC,' NBEL=',NBEL,MP,NP,NC
  1330. C===============================================
  1331. DO 108 KE=1,NBEL
  1332.  
  1333. NK1=KE + IK1*(1 - KE)
  1334. NK2=KE + IK2*(1 - KE)
  1335. NK3=KE + IK3*(1 - KE)
  1336. NK4=KE + IK4*(1 - KE)
  1337.  
  1338. DO 109 I=1,NP
  1339. J=IPT1.NUM(I,KE)
  1340. DO 109 N=1,IDIM
  1341. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  1342. 109 CONTINUE
  1343.  
  1344. IF(TLINCO)THEN
  1345. DO 107 I=1,NP
  1346. I1=MLENT1.LECT(IPT1.NUM(I,KE))
  1347. DO 107 N=1,NC
  1348. TN1(I,N)=MTETA1.VPOCHA(I1,N)
  1349. 107 CONTINUE
  1350. ENDIF
  1351.  
  1352. IF(XBDF)THEN
  1353. DO 106 I=1,NP
  1354. I2=MLENT2.LECT(IPT1.NUM(I,KE))
  1355. DO 106 N=1,NC
  1356. TN2(I,N)=MTETA2.VPOCHA(I2,N)
  1357. 106 CONTINUE
  1358. ENDIF
  1359.  
  1360. CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  1361. * IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  1362.  
  1363. IF (IDCEN.EQ.0.OR.IDCEN.EQ.1) THEN
  1364. CALL RSETD(WT,FN,(NP*NPG))
  1365. CALL RSETD(WS,FN,(NP*NPG))
  1366. ELSE
  1367. CALL CALDEC(WT,WS,XYZ,GR,HR,FN,NES,IDIM,NP,NPG,AJT,
  1368. & IDCEN,CMT,MELVA1.VELCHE(1,NK1),MELVA2.VELCHE(1,NK2),
  1369. & MELVA3.VELCHE(1,NK3),TN1,NC,IKOMP,XREF,AIRE,KE)
  1370. ENDIF
  1371.  
  1372. CALL INITD(RF1,(NP*MP*IDIM),0.D0)
  1373. CALL INITD(SM1,(MP*IDIM),0.D0)
  1374.  
  1375. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1376. IF(TDFDT) THEN
  1377. C...... Terme Transitoire
  1378.  
  1379. c? write(6,*)' IDCEN TRAN=',IDCEN,CMD,DELTAT,' NC=',nc
  1380. c? write(6,*)' XBDF=',XBDF,' XDIAG=',XDIAG,' MP=',mp
  1381. DO 110 I=1,MP
  1382. CALL INITD(SU,NC,0.D0)
  1383. UD=0.D0
  1384.  
  1385. DO 111 J=1,NP
  1386. U1=0.D0
  1387. TV=0.D0
  1388. DO 112 LG=1,NPG
  1389.  
  1390. C1=MELVA1.VELCHE(LG,NK1)
  1391.  
  1392. c? DO 114 N=1,IDIM
  1393. c? IF(XTV)THEN
  1394. c? C3=MELVA3.VELCHE((N-1)*NPG+LG,NK3)
  1395. c? TV=TV+MELVA3.VELCHE((IDIM+I-1)*NPG+LG,NK3)*HR(N,J,LG)
  1396. c? & *PGSQ(LG)*C3*C1*DEUPI*RPG(LG)
  1397. c? ELSEIF(XTG)THEN
  1398. c? C3=MELVA3.VELCHE((N-1)*NPG+LG,NK3)
  1399. c? TV=TV+MELVA3.VELCHE((IDIM+I-1)*NPG+LG,NK3)*HR(N,J,LG)
  1400. c? & *PGSQ(LG)*C3*C1*DEUPI*RPG(LG)
  1401. c? ENDIF
  1402. c? 114 CONTINUE
  1403.  
  1404. U1=U1+WT(I,LG)*FN(J,LG)*PGSQ(LG)*C1*DEUPI*RPG(LG)
  1405.  
  1406. 112 CONTINUE
  1407.  
  1408. IF(XDIAG)THEN
  1409. UD=UD+U1
  1410. U1=0.D0
  1411. ENDIF
  1412.  
  1413. IF(XBDF.AND.(.NOT.XDIAG))THEN
  1414. U1=U1/DELTAT
  1415. DO 116 N=1,NC
  1416. SU(N) = SU(N) + (2.D0*TN1(J,N) - 0.5D0*TN2(J,N))*U1
  1417. 116 continue
  1418. U1=U1*1.5D0
  1419. ELSEIF(.NOT.XBDF)THEN
  1420. U1=U1/DELTAT
  1421. do 1161 n=1,nc
  1422. SU(N) = SU(N) + (U1 + (AIMPL-1.D0)*(-TV))*TN1(J,N)
  1423. 1161 CONTINUE
  1424. ENDIF
  1425.  
  1426. RF1(J,I,1)=RF1(J,I,1)+U1+(AIMPL*TV)
  1427.  
  1428. 111 CONTINUE
  1429.  
  1430. IF(XDIAG)THEN
  1431. UD=UD/DELTAT
  1432. IF(XBDF)THEN
  1433. do 119 n=1,nc
  1434. SU(N) = SU(N) + (2.D0*TN1(I,N) - 0.5D0*TN2(I,N))*UD
  1435. 119 continue
  1436. UD=UD*1.5D0
  1437. ELSE
  1438. do 118 n=1,nc
  1439. SU(N) = SU(N) + UD*TN1(I,N)
  1440. 118 continue
  1441. ENDIF
  1442. RF1(I,I,1)=RF1(I,I,1)+UD
  1443. ENDIF
  1444.  
  1445. DO 117 N=1,NC
  1446. SM1(I,N)=SM1(I,N)+ SU(N)
  1447. 117 CONTINUE
  1448.  
  1449. 110 CONTINUE
  1450. c write(6,*)' apres SM1(I,N)='
  1451. c write(6,1002)(SM1(I,1),I=1,np)
  1452. c write(6,1002)(SM1(I,2),I=1,np)
  1453. C...... Transitoire Fin
  1454. ENDIF
  1455. C=======================================================================
  1456.  
  1457. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1458. IF(TCONV) THEN
  1459. C...... Convection
  1460. DO 410 I=1,MP
  1461. CALL INITD(SU,NC,0.D0)
  1462.  
  1463. DO 411 J=1,NP
  1464. U3=0.D0
  1465. DO 412 LG=1,NPG
  1466.  
  1467. C1=MELVA1.VELCHE(LG,NK1)
  1468. DO 414 N=1,IDIM
  1469. C3=MELVA3.VELCHE((N-1)*NPG+LG,NK3)
  1470. U3=U3+WT(I,LG)*HR(N,J,LG)*PGSQ(LG)*C3*C1*DEUPI*RPG(LG)
  1471. 414 CONTINUE
  1472.  
  1473. 412 CONTINUE
  1474.  
  1475. DO 416 N=1,NC
  1476. SU(N) = SU(N) + (AIMPL-1.D0)*U3*TN1(J,N)
  1477. 416 CONTINUE
  1478.  
  1479. RF1(J,I,1)=RF1(J,I,1)+(AIMPL*U3)
  1480.  
  1481. 411 CONTINUE
  1482.  
  1483. DO 417 N=1,NC
  1484. SM1(I,N)=SM1(I,N)+ SU(N)
  1485. 417 CONTINUE
  1486.  
  1487. 410 CONTINUE
  1488. C...... Convection Fin
  1489. ENDIF
  1490. C=======================================================================
  1491.  
  1492. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1493. IF(TLAPN) THEN
  1494. C...... Laplacien
  1495. DO 310 I=1,MP
  1496. CALL INITD(SU,NC,0.D0)
  1497. DO 311 J=1,NP
  1498. U2=0.D0
  1499. UR=0.D0
  1500. DO 312 LG=1,NPG
  1501.  
  1502. C2=MELVA2.VELCHE(LG,NK2)
  1503.  
  1504. DO 313 N=1,IDIM
  1505. U2=U2+IZWH.HR(N,I,LG)*HR(N,J,LG)*PGSQ(LG)*C2*DEUPI*RPG(LG)
  1506. 313 CONTINUE
  1507.  
  1508. IF(IHV.EQ.1.AND.IAXI.EQ.2)THEN
  1509. C cas 2D axi Laplacien Champ vitesse
  1510. UR=UR+WT(I,LG)*FN(J,LG)/RPG(LG)*PGSQ(LG)*C2*DEUPI
  1511. C cas 2D axi Laplacien Champ vitesse Fin
  1512. ENDIF
  1513.  
  1514. 312 CONTINUE
  1515.  
  1516. DO 316 N=1,NC
  1517. SU(N) = SU(N) + (AIMPL-1.D0)*(U2+UR)*TN1(J,N)
  1518. 316 CONTINUE
  1519.  
  1520. RF1(J,I,1)=RF1(J,I,1)+(AIMPL*(U2+UR))
  1521.  
  1522. 311 CONTINUE
  1523.  
  1524. DO 317 N=1,NC
  1525. SM1(I,N)=SM1(I,N) + SU(N)
  1526. 317 CONTINUE
  1527.  
  1528. 310 CONTINUE
  1529. C...... Laplacien Fin
  1530. ENDIF
  1531. C=======================================================================
  1532.  
  1533. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1534. IF(TMASS) THEN
  1535. C...... Masse
  1536. DO 210 I=1,MP
  1537. CALL INITD(SU,NC,0.D0)
  1538. UD=0.D0
  1539. DO 211 J=1,NP
  1540. U1=0.D0
  1541. DO 212 LG=1,NPG
  1542.  
  1543. C1=MELVA1.VELCHE(LG,NK1)
  1544. U1=U1+WT(I,LG)*FN(J,LG)*PGSQ(LG)*C1*DEUPI*RPG(LG)
  1545.  
  1546.  
  1547. 212 CONTINUE
  1548.  
  1549. IF(XDIAG)THEN
  1550. UD=UD+U1
  1551. U1=0.D0
  1552. ELSE
  1553. DO 216 N=1,NC
  1554. SU(N) = SU(N) + (AIMPL-1.D0)*U1*TN1(J,N)
  1555. 216 CONTINUE
  1556. RF1(J,I,1)=RF1(J,I,1)+AIMPL*U1
  1557. ENDIF
  1558.  
  1559. 211 CONTINUE
  1560.  
  1561. IF(XDIAG)THEN
  1562. RF1(I,I,1)=RF1(I,I,1)+AIMPL*UD
  1563. DO 218 N=1,NC
  1564. SM1(I,N)=SM1(I,N)+ (AIMPL-1.D0)*UD*TN1(I,N)
  1565. 218 CONTINUE
  1566. ELSE
  1567. DO 217 N=1,NC
  1568. SM1(I,N)=SM1(I,N)+ SU(N)
  1569. 217 CONTINUE
  1570. ENDIF
  1571.  
  1572. 210 CONTINUE
  1573. C...... Masse Fin
  1574. ENDIF
  1575. C=======================================================================
  1576.  
  1577. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1578. IF(TSOUR) THEN
  1579. C...... Source
  1580. DO 610 I=1,MP
  1581. C1=1.D0
  1582. DO 617 N=1,NC
  1583. U4=0.D0
  1584. DO 615 LG=1,NPG
  1585. IF(TECHI)THEN
  1586. C1=MELVA1.VELCHE(LG,NK1)
  1587. ENDIF
  1588. C4=MELVA4.VELCHE((N-1)*NPG+LG,NK4)
  1589. U4=U4+WS(I,LG)*PGSQ(LG)*C4*C1*DEUPI*RPG(LG)
  1590. 615 CONTINUE
  1591. SM1(I,N)=SM1(I,N)+ U4
  1592. 617 CONTINUE
  1593. 610 CONTINUE
  1594. C...... Source Fin
  1595. ENDIF
  1596. C=======================================================================
  1597.  
  1598.  
  1599. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  1600. C ...... Chargement Rigidite ou Matrik
  1601. IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN)THEN
  1602. C Cas RIGIDITE
  1603. IF(XRIG)THEN
  1604. * XMATRI=IMATTT(KE)
  1605. DO 901 I=1,MP
  1606. DO 901 J=1,NP
  1607. RE(I,J,ke)=RF1(J,I,1)
  1608. 901 CONTINUE
  1609. * SEGDES XMATRI
  1610. ELSE
  1611. C Cas MATRIK
  1612. DO 902 N=1,NBME
  1613. JMATR1=JRIGEL(4,NMATR0+N)
  1614. IPM4=JMATR1.LIZAFM(L,1)
  1615. DO 902 I=1,NP
  1616. DO 902 J=1,NP
  1617. IPM4.AM(KE,J,I)=RF1(J,I,1)
  1618. 902 CONTINUE
  1619. ENDIF
  1620. ENDIF
  1621. C ...... Chargement Second membre
  1622. DO 910 I=1,NP
  1623. I1=LECT(IPT1.NUM(I,KE))
  1624. DO 910 N=1,NC
  1625. MPOVA1.VPOCHA(I1,N)=MPOVA1.VPOCHA(I1,N)+SM1(I,N)
  1626. 910 CONTINUE
  1627. C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  1628.  
  1629. 108 CONTINUE
  1630.  
  1631. IF(TDFDT.OR.TMASS.OR.TCONV)THEN
  1632. SEGSUP MCHAM1,MELVA1
  1633. ENDIF
  1634.  
  1635. IF(TSOUR)THEN
  1636. SEGSUP MCHAM4,MELVA4
  1637. ENDIF
  1638.  
  1639. IF(TLAPN.OR.TCONV)THEN
  1640. SEGSUP MCHAM2,MELVA2
  1641. ENDIF
  1642.  
  1643. IF(TCONV)THEN
  1644. SEGSUP MCHAM3,MELVA3
  1645. ENDIF
  1646.  
  1647. NUTOEL=NUTOEL+NBEL
  1648.  
  1649. SEGDES IPT1,IPT2
  1650.  
  1651. IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN.OR.TKBBT)THEN
  1652. C Cas RIGIDITE
  1653. IF(XRIG)THEN
  1654. SEGDES xMATRI
  1655. ELSE
  1656. C Cas MATRIK
  1657. SEGDES IPM1
  1658. IF(NBME.GE.2)SEGDES IPM2
  1659. IF(NBME.GE.3)SEGDES IPM3
  1660. ENDIF
  1661. ENDIF
  1662.  
  1663. SEGSUP IZFFM,IZHR,IZF1,IZH2
  1664. SEGSUP SAJT
  1665.  
  1666. 101 CONTINUE
  1667.  
  1668. IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN)THEN
  1669. IF(.NOT.XRIG)THEN
  1670. DO 141 M=1,NBME
  1671. JMATRI=JRIGEL(4,NMATR0+M)
  1672. SEGDES JMATRI
  1673. 141 CONTINUE
  1674. ENDIF
  1675. ENDIF
  1676.  
  1677. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1678. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1679. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1680. ELSEIF(TVITP)THEN
  1681.  
  1682. CALL KRIPAD(MELEMS,MLENTI)
  1683. SEGDES MELEMS
  1684.  
  1685. NUTOEL=0
  1686. SEGACT MELEME,MELEM2
  1687. NBSOUS=LISOUS(/1)
  1688. IF(NBSOUS.EQ.0)NBSOUS=1
  1689.  
  1690. C Cas RIGIDITE Pleine
  1691. IF(XRIG)THEN
  1692. NRIGE=8
  1693. NRI=IRIGEL(/2)
  1694. NRIGEL=NBSOUS+NRI
  1695. SEGADJ MRIGID
  1696. c write(6,*)' NRIGE,NRIGEL,MRIGID=',NRIGE,NRIGEL,MRIGID
  1697.  
  1698. ELSE
  1699. C Cas MATRIK Pleine
  1700. NRIGE=7
  1701. NKID =9
  1702. NKMT =7
  1703. NMATR0=JRIGEL(/2)
  1704. NMATRI=NMATR0+1
  1705. SEGADJ MATRIK
  1706.  
  1707. NBMF=1
  1708. IF(IHV.EQ.1)NBMF=IDIM
  1709. SEGINI JMATRI
  1710. c write(6,*)' KBBT JMATRI=',JMATRI,MELEMS,MELEMP
  1711. JRIGEL(4,NMATR0+1)=JMATRI
  1712.  
  1713. IF(IKAS.EQ.1.OR.IKAS.EQ.3)THEN
  1714. JRIGEL(7,NMATR0+1)=-3
  1715. IF(IKAS.EQ.3)JRIGEL(7,NMATR0+1)=4
  1716. JRIGEL(1,NMATR0+1)=MELEME
  1717. JRIGEL(2,NMATR0+1)=MELEM2
  1718. KSPGP=MELEMS
  1719. KSPGD=MELEMP
  1720. IF(NBMF.EQ.1)THEN
  1721. LISPRI(1)=NOMP(1)//' '
  1722. LJSDUA(1)=NOMD(1)//' '
  1723. ELSE
  1724. DO 42 I=1,NBMF
  1725. LISPRI(I)=NOMP(I)//' '
  1726. LJSDUA(I)=NOMD(I)//' '
  1727. 42 CONTINUE
  1728. ENDIF
  1729. ELSEIF(IKAS.EQ.2)THEN
  1730. JRIGEL(7,NMATR0+1)=3
  1731. JRIGEL(1,NMATR0+1)=MELEM2
  1732. JRIGEL(2,NMATR0+1)=MELEME
  1733. KSPGP=MELEMP
  1734. KSPGD=MELEMS
  1735. IF(NBMF.EQ.1)THEN
  1736. LISPRI(1)=NOMD(1)//' '
  1737. LJSDUA(1)=NOMP(1)//' '
  1738. ELSE
  1739. DO 43 I=1,NBMF
  1740. LISPRI(I)=NOMD(I)//' '
  1741. LJSDUA(I)=NOMP(I)//' '
  1742. 43 CONTINUE
  1743. ENDIF
  1744. ELSE
  1745. RETURN
  1746. ENDIF
  1747. ENDIF
  1748.  
  1749. IF(TPROJ)JRIGEL(7,NMATR0+1)=4
  1750.  
  1751. IF(TKBBT)SEGACT MCHEL1
  1752. IF(TLINCO)THEN
  1753. SEGACT MTETA1
  1754. IF(XBDF)SEGACT MTETA2
  1755. ENDIF
  1756.  
  1757. IF(MAX(1,MELEM2.LISOUS(/1)).NE.MAX(1,LISOUS(/1)))THEN
  1758. WRITE(6,*)' Geometries incompatibles dans ',nomper
  1759. C% Données incompatibles
  1760. CALL ERREUR(22)
  1761. RETURN
  1762. ENDIF
  1763.  
  1764. IF(INEFMD.EQ.2.AND.MPRE.EQ.'CENTRE'.AND.IKAS.NE.2)THEN
  1765. C CAS Stabilisation via MACRO CENTRE
  1766. c write(6,*)' CAS Stabilisation via MACRO CENTRE '
  1767.  
  1768. TYPE=' '
  1769. CALL ACMO(MTABZ,'MELSTB',TYPE,MELSTB)
  1770. TYPE=' '
  1771. CALL ACMO(MTABZ,'MCHPOC',TYPE,MCHPOC)
  1772.  
  1773. SEGACT MELSTB
  1774. IF(IDIM.EQ.2)NBELEM=MELSTB.NUM(/2)/4
  1775. IF(IDIM.EQ.3)NBELEM=MELSTB.NUM(/2)/8
  1776. NBNN=MELSTB.NUM(/1)
  1777. NBSOUS=0
  1778. NBREF=0
  1779. SEGINI MELEMA
  1780. MELEMA.ITYPEL=MELSTB.ITYPEL
  1781.  
  1782. NKPE=4
  1783. IF(IDIM.EQ.3)NKPE=8
  1784. DO 4878 k=1,NBELEM
  1785. MI=(K-1)*NKPE+1
  1786. DO 4879 I=1,NBNN
  1787. MELEMA.NUM(I,K)=MELSTB.NUM(I,MI)
  1788. 4879 CONTINUE
  1789. 4878 CONTINUE
  1790.  
  1791. BETA0=-ABS(CSTAB)
  1792. IF(TPROJ)BETA0=ABS(CSTAB)
  1793. c write(6,*)'TPROJ BETA0=',TPROJ,BETA0
  1794. NK=0
  1795. NMATR0=JRIGEL(/2)
  1796. NMATRI=NMATR0+1
  1797. SEGADJ MATRIK
  1798. NBMF=1
  1799. NBSOUS=1
  1800. SEGINI JMATRS
  1801. JRIGEL(4,NMATR0+1)=JMATRS
  1802. JMATRS.KSPGP=MELEMC
  1803. JMATRS.KSPGD=MELEMC
  1804. JRIGEL(1,NMATR0+1)=MELEMA
  1805. JRIGEL(2,NMATR0+1)=MELEMA
  1806. JRIGEL(7,NMATR0+1)=0
  1807. CALL LRCHT(MCHPOC,MPOVAL,TYPE,IGEOM)
  1808.  
  1809.  
  1810. NBSOUS=MELSTB.LISOUS(/1)
  1811. IF(NBSOUS.NE.0)THEN
  1812. CALL ERREUR(5)
  1813. ENDIF
  1814.  
  1815. NBEL=MELEMA.NUM(/2)
  1816. NBCI=MELSTB.NUM(/2)
  1817. NP =MELSTB.NUM(/1)
  1818. MP =NP
  1819.  
  1820. SEGINI IZAFM
  1821. JMATRS.LIZAFM(1,1)=IZAFM
  1822. JMATRS.LISPRI(1)=NOMD(1)
  1823. JMATRS.LJSDUA(1)=NOMD(1)
  1824.  
  1825. CALL KRIPAD(MELEMC,MLENT1)
  1826.  
  1827. DO 33 K=1,NBEL
  1828.  
  1829. NK=NK+1
  1830.  
  1831. DO 32 J=1,NP
  1832. K1=MLENT1.LECT(MELEMA.NUM(J,K))
  1833. II=J
  1834. DO 34 I=1,NP
  1835. U=VPOCHA(K1,I)*BETA0
  1836. IF(I.EQ.1)U=ABS(VPOCHA(K1,I))*BETA0
  1837. IF(II.LE.NP)THEN
  1838. AM(K,II,J)=U
  1839. ELSE
  1840. AM(K,II-NP,J)=U
  1841. ENDIF
  1842. II=II+1
  1843. 34 CONTINUE
  1844. 32 CONTINUE
  1845. 33 CONTINUE
  1846.  
  1847. SEGDES MELEMA,MELSTB,MELEMC,IZAFM,MPOVAL
  1848. SEGSUP MLENT1
  1849.  
  1850. c write(6,*)' Fin Stab '
  1851. ENDIF
  1852. SEGACT MELEME,MELEM2
  1853.  
  1854. DO 201 L=1,MAX(1,LISOUS(/1))
  1855. IPT1=MELEME
  1856. IPT2=MELEM2
  1857. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  1858. IF(MELEM2.LISOUS(/1).NE.0)IPT2=MELEM2.LISOUS(L)
  1859. SEGACT IPT1,IPT2
  1860.  
  1861. C /S INEFMD : Type formulation
  1862. C INEFMD = 1 LINE,
  1863. C = 2 MACRO,
  1864. C = 3 QUADRATIQUE,
  1865. C = 4 LINB.
  1866. NOM0='????????'
  1867. IF(INEFMD.EQ.1)THEN
  1868. IF(MPRE.EQ.'CENTRE ')NOM0=NOMS(IPT1.ITYPEL)//' '
  1869. IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'P1P1'
  1870. ELSEIF(INEFMD.EQ.2)THEN
  1871. IF(MPRE.EQ.'CENTRE ')NOM0=NOMS(IPT1.ITYPEL)//' '
  1872.  
  1873. c ces elements ne marchent pas
  1874. IF(MPRE.EQ.'CENTREP0')NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  1875. IF(MPRE.EQ.'CENTREP1')NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  1876.  
  1877. IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'MCF1'
  1878. ELSEIF(INEFMD.EQ.3)THEN
  1879. IF(MPRE.EQ.'CENTREP0')NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  1880. IF(MPRE.EQ.'CENTREP1')NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  1881. IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'PFP1'
  1882. ELSEIF(INEFMD.EQ.4)THEN
  1883. IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//' '
  1884. ENDIF
  1885. IF(NOM0.EQ.'????????')THEN
  1886. C% Le type d'element fini Vitesse/pression ne convient pas : %m1:8 %m9:16 .
  1887. MOTERR( 1: 8) =LSOPT(INEFMD)
  1888. MOTERR( 9:16) =MPRE
  1889. WRITE(IOIMP,*)'Operateur : ',NOMPER
  1890. CALL ERREUR(933)
  1891. RETURN
  1892. ENDIF
  1893.  
  1894. c write(6,*)nomper,' NOM0=',nom0,
  1895. c write(6,*)' 2eme KALPBG NOM0=',NOM0,IPT1
  1896. CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  1897. if(IZFFM.eq.0)return
  1898.  
  1899. SEGACT IZFFM*MOD
  1900. IZHR=KZHR(1)
  1901. IZH2=KZHR(2)
  1902.  
  1903. SEGACT IZHR*MOD,IZH2*MOD
  1904.  
  1905. NES=GR(/1)
  1906. NPG=GR(/3)
  1907. IZF1=KTP(1)
  1908. SEGACT IZF1*MOD
  1909. NP = IPT1.NUM(/1)
  1910. MP = IPT2.NUM(/1)
  1911. IF(IKAS.EQ.2)THEN
  1912. MP = IPT1.NUM(/1)
  1913. NP = IPT2.NUM(/1)
  1914. ENDIF
  1915.  
  1916. NBEL=IPT1.NUM(/2)
  1917.  
  1918. SEGINI SAJT
  1919.  
  1920. C Cas RIGIDITE
  1921. IF(XRIG)THEN
  1922. IRIGEL(1,NRI+L)=MELEME
  1923. COERIG(L)=1.D0
  1924.  
  1925. IRIGEL(7,NRI+L)=0
  1926. IF(TCONV)IRIGEL(7,NRI+L)=2
  1927.  
  1928. NBME=1
  1929. IF(IHV.EQ.1)NBME=IDIM
  1930. NLIGRP=NP
  1931. NLIGRD=MP
  1932. SEGINI DESCR
  1933. IRIGEL(3,NRI+L)=DESCR
  1934. IF(NBME.EQ.1)THEN
  1935. DO 202 I=1,NLIGRP
  1936. LISINC(I)=NOMP(1)//' '
  1937. NOELEP(I)=I
  1938. 202 CONTINUE
  1939. DO 203 I=1,NLIGRD
  1940. LISDUA(I)=NOMD(1)//' '
  1941. NOELED(I)=I
  1942. 203 CONTINUE
  1943. ELSE
  1944. ENDIF
  1945. SEGDES DESCR
  1946.  
  1947. NELRIG=NBEL
  1948. SEGINI xMATRI
  1949. IRIGEL(4,NRI+L)=xMATRI
  1950. xmatri.symre=irigel(7,nri+l)
  1951. c write(6,*)'NELRIG,IMATRI=',NELRIG,IMATRI
  1952.  
  1953. * DO 204 K=1,NELRIG
  1954. * SEGINI XMATRI
  1955. c write(6,*)'NLIGRD,NLIGRP,XMATRI=',NLIGRD,NLIGRP,XMATRI
  1956. * IMATTT(K)=XMATRI
  1957. * 204 CONTINUE
  1958.  
  1959. ELSE
  1960. C Cas MATRIK
  1961. NBMF=LIZAFM(/2)
  1962. SEGINI IPM1
  1963. LIZAFM(L,1)=IPM1
  1964. IPM2=IPM1
  1965. IPM3=IPM1
  1966. IF(NBMF.GE.2)THEN
  1967. SEGINI IPM2
  1968. LIZAFM(L,2)=IPM2
  1969. ENDIF
  1970. IF(NBMF.GE.3)THEN
  1971. SEGINI IPM3
  1972. LIZAFM(L,3)=IPM3
  1973. ENDIF
  1974. ENDIF
  1975.  
  1976. C----Ro
  1977. IK1=1
  1978. IF(TKBBT)THEN
  1979. MCHAM1=MCHEL1.ICHAML(L)
  1980. SEGACT MCHAM1
  1981.  
  1982. MELVA1=MCHAM1.IELVAL(1)
  1983. SEGACT MELVA1
  1984. N1PTEL=MELVA1.VELCHE(/1)
  1985. N1EL=MELVA1.VELCHE(/2)
  1986. IF(N1EL.EQ.1)THEN
  1987. IK1=1
  1988. ELSEIF(N1EL.EQ.NBEL)THEN
  1989. IK1=0
  1990. ENDIF
  1991. ENDIF
  1992.  
  1993. c write(6,*)'AVT208 NC=',NC,'IK1=',IK1,'NP=',NP,'MP=',MP,'MP1=',MP1
  1994. C===============================================
  1995. DO 208 KE=1,NBEL
  1996.  
  1997. NK1=KE + IK1*(1 - KE)
  1998.  
  1999. DO 209 I=1,NP
  2000. J=IPT1.NUM(I,KE)
  2001. DO 209 N=1,IDIM
  2002. XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  2003. 209 CONTINUE
  2004.  
  2005. CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  2006. * IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  2007.  
  2008. CALL INITD(RF1,(NP*MP*IDIM),0.D0)
  2009. c CALL INITD(SM1,NP,0.D0)
  2010.  
  2011. c DO 207 I=1,NP
  2012. c I1=MLENT1.LECT(IPT1.NUM(I,KE))
  2013. c DO 207 N=1,NC
  2014. c TN1(I,N)=MTETA1.VPOCHA(I1,N)
  2015. c207 CONTINUE
  2016.  
  2017. c IF(XBDF)THEN
  2018. c DO 206 I=1,NP
  2019. c I2=MLENT2.LECT(IPT1.NUM(I,KE))
  2020. c DO 206 N=1,NC
  2021. c TN2(I,N)=MTETA2.VPOCHA(I2,N)
  2022. c206 CONTINUE
  2023. c ENDIF
  2024.  
  2025.  
  2026. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2027. IF(TKBBT) THEN
  2028. C...... Matrice C Ct
  2029.  
  2030. c write(6,*)' Calcul C Ct'
  2031. DO 510 N=1,IDIM
  2032. DO 510 I=1,MP
  2033. DO 511 J=1,NP
  2034. U1=0.D0
  2035. DO 512 LG=1,NPG
  2036. C1=MELVA1.VELCHE(LG,NK1)
  2037. U1=U1+IZF1.FN(I,LG)*HR(N,J,LG)*PGSQ(LG)*DEUPI*RPG(LG)*C1
  2038. 512 CONTINUE
  2039. RF1(J,I,N)=RF1(J,I,N)+U1
  2040. 511 CONTINUE
  2041. 510 CONTINUE
  2042. C...... Matrice C Ct Fin
  2043. ENDIF
  2044. C=======================================================================
  2045.  
  2046. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  2047. C ...... Chargement Rigidite ou Matrik
  2048. c write(6,*)' Chargement Rigidite ou Matrik'
  2049. C Cas RIGIDITE
  2050. IF(XRIG)THEN
  2051. * XMATRI=IMATTT(KE)
  2052. DO 921 I=1,MP
  2053. DO 921 J=1,NP
  2054. RE(I,J,ke)=RF1(J,I,1)
  2055. 921 CONTINUE
  2056. * SEGDES XMATRI
  2057. ELSE
  2058. C Cas MATRIK
  2059. DO 923 N=1,NBMF
  2060. IPM4=LIZAFM(L,N)
  2061. c write(6,*)'IPM4=',IPM4
  2062. DO 922 I=1,MP
  2063. DO 922 J=1,NP
  2064. IPM4.AM(KE,J,I)=RF1(J,I,N)
  2065. 922 CONTINUE
  2066. 923 CONTINUE
  2067. c write(6,*)' Fin Chargement'
  2068. ENDIF
  2069. C ...... Chargement Second membre
  2070. c DO 920 I=1,NP
  2071. c I1=LECT(IPT1.NUM(I,KE))
  2072. c DO 920 N=1,NC
  2073. c MPOVA1.VPOCHA(I1,N)=MPOVA1.VPOCHA(I1,N)+SM1(I,N)
  2074. c920 CONTINUE
  2075. C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  2076.  
  2077.  
  2078.  
  2079. 208 CONTINUE
  2080.  
  2081. IF(TKBBT)THEN
  2082. SEGSUP MCHAM1,MELVA1
  2083. ENDIF
  2084.  
  2085. NUTOEL=NUTOEL+NBEL
  2086.  
  2087. SEGDES IPT1,IPT2
  2088.  
  2089. IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN.OR.TKBBT)THEN
  2090. C Cas RIGIDITE
  2091. IF(XRIG)THEN
  2092. SEGDES xMATRI
  2093. ELSE
  2094. C Cas MATRIK
  2095. SEGDES IPM1
  2096. IF(NBMF.GE.2)SEGDES IPM2
  2097. IF(NBMF.GE.3)SEGDES IPM3
  2098. ENDIF
  2099. ENDIF
  2100.  
  2101. SEGSUP IZFFM,IZHR,IZF1,IZH2
  2102. SEGSUP SAJT
  2103.  
  2104. 201 CONTINUE
  2105.  
  2106. C Cas RIGIDITE
  2107. IF(XRIG)THEN
  2108. ELSE
  2109. C Cas MATRIK
  2110. NMATRI=JRIGEL(/2)
  2111. DO 205 I=1,NMATRI
  2112. JMATRI=JRIGEL(4,I)
  2113. SEGDES JMATRI
  2114. 205 CONTINUE
  2115. ENDIF
  2116.  
  2117. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  2118. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  2119. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  2120. ENDIF
  2121.  
  2122.  
  2123. IF(TDFDT)THEN
  2124. SEGSUP MCHEL1
  2125. ENDIF
  2126.  
  2127. IF(TSOUR)THEN
  2128. SEGSUP MCHEL4
  2129. ENDIF
  2130.  
  2131. IF(TLAPN.OR.TCONV)THEN
  2132. SEGSUP MCHEL2
  2133. ENDIF
  2134.  
  2135. IF(TCONV)THEN
  2136. SEGSUP MCHEL3
  2137. ENDIF
  2138.  
  2139.  
  2140. SEGDES MCHPO1,MPOVA1
  2141. SEGDES MELEME,MELEM2
  2142.  
  2143. SEGSUP MLENTI
  2144. IF(TLINCO)THEN
  2145. SEGSUP MLENT1
  2146. SEGDES MTETA1
  2147. IF(XBDF)THEN
  2148. SEGSUP MLENT2
  2149. SEGDES MTETA2
  2150. ENDIF
  2151. ENDIF
  2152.  
  2153. c write(6,*)' NINKO=',NINKO
  2154. IF(NINKO.GE.2.AND.TLINCO)THEN
  2155. SEGSUP MLENT3
  2156. SEGDES MTETA3
  2157. IF(XBDF)THEN
  2158. SEGSUP MLENT4
  2159. SEGDES MTETA4
  2160. ENDIF
  2161. ENDIF
  2162.  
  2163. C Cas RIGIDITE
  2164. IF(XRIG)THEN
  2165. c write(6,*)' On ecrit bien une rigidite ',MRIGID
  2166. SEGDES MRIGID
  2167. CALL ECROBJ('RIGIDITE',MRIGID)
  2168. ELSE
  2169. C Cas MATRIK
  2170. c write(6,*)' On ecrit bien un MATRIK ',MATRIK
  2171. SEGDES MATRIK
  2172. CALL ECROBJ('MATRIK',MATRIK)
  2173. ENDIF
  2174.  
  2175. c write(6,*)'On ecrit bien un CHPOINT',MCHPO1
  2176. CALL ECROBJ('CHPOINT',MCHPO1)
  2177. C*************************************************************************
  2178.  
  2179. c write(6,*)' FIN YTCLSF'
  2180. RETURN
  2181. 1001 FORMAT(20(1X,I5))
  2182. 1002 FORMAT(10(1X,1PE11.4))
  2183. END
  2184.  
  2185.  
  2186.  
  2187.  
  2188.  
  2189.  
  2190.  
  2191.  
  2192.  
  2193.  
  2194.  
  2195.  
  2196.  
  2197.  
  2198.  
  2199.  
  2200.  
  2201.  
  2202.  
  2203.  
  2204.  
  2205.  
  2206.  
  2207.  
  2208.  
  2209.  
  2210.  
  2211.  
  2212.  
  2213.  
  2214.  
  2215.  

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