Télécharger la plaquette Cast3M


fr en

Télécharger ytclsf.eso

Retour à la liste

Numérotation des lignes : 

ytclsf

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

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