Télécharger ytclsf.eso

Retour à la liste

Numérotation des lignes :

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

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