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    PV090527  26/04/30    21:16:50     12529          
  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.         rigrel=0
  1234.         SEGINI xMATRI
  1235.         IRIGEL(4,NRI+L)=xMATRI
  1236.         xmatri.symre=irigel(7,nri+l)
  1237. c       write(6,*)'NELRIG,IMATRI=',NELRIG,IMATRI
  1238.  
  1239. *        DO 104 K=1,NELRIG
  1240. *        SEGINI XMATRI
  1241. c       write(6,*)'NLIGRD,NLIGRP,XMATRI=',NLIGRD,NLIGRP,XMATRI
  1242. *        IMATTT(K)=XMATRI
  1243. * 104    CONTINUE
  1244.  
  1245.       ELSE
  1246. C Cas MATRIK
  1247.         SEGINI IPM1
  1248.         JMATR1=JRIGEL(4,NMATR0+1)
  1249.         JMATR1.LIZAFM(L,1)=IPM1
  1250.         IPM2=IPM1
  1251.         IPM3=IPM1
  1252.          IF(NBME.GE.2)THEN
  1253.           JMATR2=JRIGEL(4,NMATR0+2)
  1254.  
  1255.           IF(IAXI.NE.0)THEN
  1256.            SEGINI IPM2
  1257.            JMATR2.LIZAFM(L,1)=IPM2
  1258.            ICAL2=.TRUE.
  1259.           ELSE
  1260.            IPM2=IPM1
  1261.            JMATR2.LIZAFM(L,1)=IPM2
  1262.            ICAL2=.FALSE.
  1263.           ENDIF
  1264.  
  1265.          ENDIF
  1266.          IF(NBME.GE.3)THEN
  1267.           JMATR3=JRIGEL(4,NMATR0+3)
  1268.  
  1269.            IPM3=IPM1
  1270.            JMATR3.LIZAFM(L,1)=IPM3
  1271.            ICAL3=.FALSE.
  1272.  
  1273.          ENDIF
  1274.       ENDIF
  1275.       ENDIF
  1276.  
  1277. C----Ro
  1278.       IK1=1
  1279.       IF(TDFDT.OR.TMASS.OR.TCONV)THEN
  1280.       MCHAM1=MCHEL1.ICHAML(L)
  1281.       SEGACT MCHAM1
  1282.  
  1283.       MELVA1=MCHAM1.IELVAL(1)
  1284.       SEGACT MELVA1
  1285.       N1PTEL=MELVA1.VELCHE(/1)
  1286.       N1EL=MELVA1.VELCHE(/2)
  1287.         IF(N1EL.EQ.1)THEN
  1288.         IK1=1
  1289.         ELSEIF(N1EL.EQ.NBEL)THEN
  1290.         IK1=0
  1291.         ENDIF
  1292.       ENDIF
  1293.  
  1294. C----Lambda
  1295.       IK2=1
  1296.       IF(TLAPN)THEN
  1297.       MCHAM2=MCHEL2.ICHAML(L)
  1298.       SEGACT MCHAM2
  1299.  
  1300.       MELVA2=MCHAM2.IELVAL(1)
  1301.       SEGACT MELVA2
  1302.       N1PTEL=MELVA2.VELCHE(/1)
  1303.       N1EL=MELVA2.VELCHE(/2)
  1304.         IF(N1EL.EQ.1)THEN
  1305.         IK2=1
  1306.         ELSEIF(N1EL.EQ.NBEL)THEN
  1307.         IK2=0
  1308.         ENDIF
  1309.       ENDIF
  1310.  
  1311. C----U
  1312.       IK3=1
  1313.       IF(TCONV)THEN
  1314.       MCHAM3=MCHEL3.ICHAML(L)
  1315.       SEGACT MCHAM3
  1316.  
  1317.       MELVA3=MCHAM3.IELVAL(1)
  1318.       SEGACT MELVA3
  1319.       N1PTEL=MELVA3.VELCHE(/1)
  1320.       N1EL=MELVA3.VELCHE(/2)
  1321.         IF(N1EL.EQ.1)THEN
  1322.         IK3=1
  1323.         ELSEIF(N1EL.EQ.NBEL)THEN
  1324.         IK3=0
  1325.         ENDIF
  1326.       ENDIF
  1327.  
  1328. C----source
  1329.       IK4=1
  1330.       IF(TSOUR)THEN
  1331.       MCHAM4=MCHEL4.ICHAML(L)
  1332.       SEGACT MCHAM4
  1333.  
  1334.       MELVA4=MCHAM4.IELVAL(1)
  1335.       SEGACT MELVA4
  1336.       N1PTEL=MELVA4.VELCHE(/1)
  1337.       N1EL=MELVA4.VELCHE(/2)
  1338.         IF(N1EL.EQ.1)THEN
  1339.         IK4=1
  1340.         ELSEIF(N1EL.EQ.NBEL)THEN
  1341.         IK4=0
  1342.         ENDIF
  1343.       ENDIF
  1344.  
  1345. c      write(6,*)' AVANT 108 NC=',NC,' NBEL=',NBEL,MP,NP,NC
  1346. C===============================================
  1347.         segact mcoord
  1348.         DO 108 KE=1,NBEL
  1349.  
  1350.         NK1=KE + IK1*(1 - KE)
  1351.         NK2=KE + IK2*(1 - KE)
  1352.         NK3=KE + IK3*(1 - KE)
  1353.         NK4=KE + IK4*(1 - KE)
  1354.  
  1355.         DO     I=1,NP
  1356.         J=IPT1.NUM(I,KE)
  1357.         DO     N=1,IDIM
  1358.         XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  1359.         ENDDO
  1360.         ENDDO
  1361.  
  1362.        IF(TLINCO)THEN
  1363.         DO     I=1,NP
  1364.          I1=MLENT1.LECT(IPT1.NUM(I,KE))
  1365.         DO     N=1,NC
  1366.          TN1(I,N)=MTETA1.VPOCHA(I1,N)
  1367.         ENDDO
  1368.         ENDDO
  1369.        ENDIF
  1370.  
  1371.         IF(XBDF)THEN
  1372.          DO     I=1,NP
  1373.           I2=MLENT2.LECT(IPT1.NUM(I,KE))
  1374.          DO     N=1,NC
  1375.           TN2(I,N)=MTETA2.VPOCHA(I2,N)
  1376.          ENDDO
  1377.          ENDDO
  1378.         ENDIF
  1379.  
  1380.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  1381.      *  IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  1382.  
  1383.         IF (IDCEN.EQ.0.OR.IDCEN.EQ.1) THEN
  1384.         CALL RSETD(WT,FN,(NP*NPG))
  1385.         CALL RSETD(WS,FN,(NP*NPG))
  1386.         ELSE
  1387.         CALL CALDEC(WT,WS,XYZ,GR,HR,FN,NES,IDIM,NP,NPG,AJT,
  1388.      &  IDCEN,CMT,MELVA1.VELCHE(1,NK1),MELVA2.VELCHE(1,NK2),
  1389.      &  MELVA3.VELCHE(1,NK3),TN1,NC,IKOMP,XREF,AIRE,KE)
  1390.         ENDIF
  1391.  
  1392.         CALL INITD(RF1,(NP*MP*IDIM),0.D0)
  1393.         CALL INITD(SM1,(MP*IDIM),0.D0)
  1394.  
  1395. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1396.         IF(TDFDT) THEN
  1397. C...... Terme Transitoire
  1398.  
  1399. c?      write(6,*)' IDCEN TRAN=',IDCEN,CMD,DELTAT,' NC=',nc
  1400. c?      write(6,*)' XBDF=',XBDF,' XDIAG=',XDIAG,' MP=',mp
  1401.         DO 110 I=1,MP
  1402.          CALL INITD(SU,NC,0.D0)
  1403.          UD=0.D0
  1404.  
  1405.         DO 111 J=1,NP
  1406.         U1=0.D0
  1407.         TV=0.D0
  1408.         DO 112 LG=1,NPG
  1409.  
  1410.           C1=MELVA1.VELCHE(LG,NK1)
  1411.  
  1412. c?        DO 114 N=1,IDIM
  1413. c?        IF(XTV)THEN
  1414. c?        C3=MELVA3.VELCHE((N-1)*NPG+LG,NK3)
  1415. c?        TV=TV+MELVA3.VELCHE((IDIM+I-1)*NPG+LG,NK3)*HR(N,J,LG)
  1416. c?   &         *PGSQ(LG)*C3*C1*DEUPI*RPG(LG)
  1417. c?        ELSEIF(XTG)THEN
  1418. c?        C3=MELVA3.VELCHE((N-1)*NPG+LG,NK3)
  1419. c?        TV=TV+MELVA3.VELCHE((IDIM+I-1)*NPG+LG,NK3)*HR(N,J,LG)
  1420. c?   &         *PGSQ(LG)*C3*C1*DEUPI*RPG(LG)
  1421. c?        ENDIF
  1422. c? 114      CONTINUE
  1423.  
  1424.           U1=U1+WT(I,LG)*FN(J,LG)*PGSQ(LG)*C1*DEUPI*RPG(LG)
  1425.  
  1426.  112      CONTINUE
  1427.  
  1428.            IF(XDIAG)THEN
  1429.             UD=UD+U1
  1430.             U1=0.D0
  1431.            ENDIF
  1432.  
  1433.            IF(XBDF.AND.(.NOT.XDIAG))THEN
  1434.             U1=U1/DELTAT
  1435.          DO 116 N=1,NC
  1436.             SU(N) = SU(N) + (2.D0*TN1(J,N) - 0.5D0*TN2(J,N))*U1
  1437.  116     continue
  1438.             U1=U1*1.5D0
  1439.            ELSEIF(.NOT.XBDF)THEN
  1440.             U1=U1/DELTAT
  1441.             do 1161 n=1,nc
  1442.             SU(N) = SU(N) + (U1 + (AIMPL-1.D0)*(-TV))*TN1(J,N)
  1443.  1161       CONTINUE
  1444.            ENDIF
  1445.  
  1446.           RF1(J,I,1)=RF1(J,I,1)+U1+(AIMPL*TV)
  1447.  
  1448.  111    CONTINUE
  1449.  
  1450.           IF(XDIAG)THEN
  1451.             UD=UD/DELTAT
  1452.             IF(XBDF)THEN
  1453.              do 119 n=1,nc
  1454.              SU(N) = SU(N) + (2.D0*TN1(I,N) - 0.5D0*TN2(I,N))*UD
  1455.  119         continue
  1456.              UD=UD*1.5D0
  1457.             ELSE
  1458.              do 118 n=1,nc
  1459.              SU(N) = SU(N) + UD*TN1(I,N)
  1460.  118         continue
  1461.             ENDIF
  1462.              RF1(I,I,1)=RF1(I,I,1)+UD
  1463.           ENDIF
  1464.  
  1465.          DO 117 N=1,NC
  1466.           SM1(I,N)=SM1(I,N)+ SU(N)
  1467.  117     CONTINUE
  1468.  
  1469.  110    CONTINUE
  1470. c        write(6,*)' apres SM1(I,N)='
  1471. c        write(6,1002)(SM1(I,1),I=1,np)
  1472. c        write(6,1002)(SM1(I,2),I=1,np)
  1473. C...... Transitoire Fin
  1474.         ENDIF
  1475. C=======================================================================
  1476.  
  1477. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1478.         IF(TCONV) THEN
  1479. C...... Convection
  1480.         DO 410 I=1,MP
  1481.          CALL INITD(SU,NC,0.D0)
  1482.  
  1483.         DO 411 J=1,NP
  1484.          U3=0.D0
  1485.         DO 412 LG=1,NPG
  1486.  
  1487.           C1=MELVA1.VELCHE(LG,NK1)
  1488.           DO 414 N=1,IDIM
  1489.           C3=MELVA3.VELCHE((N-1)*NPG+LG,NK3)
  1490.           U3=U3+WT(I,LG)*HR(N,J,LG)*PGSQ(LG)*C3*C1*DEUPI*RPG(LG)
  1491.  414      CONTINUE
  1492.  
  1493.  412      CONTINUE
  1494.  
  1495.         DO 416 N=1,NC
  1496.           SU(N) = SU(N) + (AIMPL-1.D0)*U3*TN1(J,N)
  1497.  416    CONTINUE
  1498.  
  1499.           RF1(J,I,1)=RF1(J,I,1)+(AIMPL*U3)
  1500.  
  1501.  411    CONTINUE
  1502.  
  1503.         DO 417 N=1,NC
  1504.           SM1(I,N)=SM1(I,N)+ SU(N)
  1505.  417    CONTINUE
  1506.  
  1507.  410    CONTINUE
  1508. C...... Convection Fin
  1509.         ENDIF
  1510. C=======================================================================
  1511.  
  1512. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1513.         IF(TLAPN) THEN
  1514. C...... Laplacien
  1515.         DO 310 I=1,MP
  1516.          CALL INITD(SU,NC,0.D0)
  1517.         DO 311 J=1,NP
  1518.         U2=0.D0
  1519.         UR=0.D0
  1520.         DO 312 LG=1,NPG
  1521.  
  1522.           C2=MELVA2.VELCHE(LG,NK2)
  1523.  
  1524.           DO 313 N=1,IDIM
  1525.           U2=U2+IZWH.HR(N,I,LG)*HR(N,J,LG)*PGSQ(LG)*C2*DEUPI*RPG(LG)
  1526.  313      CONTINUE
  1527.  
  1528.           IF(IHV.EQ.1.AND.IAXI.EQ.2)THEN
  1529. C cas 2D axi Laplacien Champ vitesse
  1530.           UR=UR+WT(I,LG)*FN(J,LG)/RPG(LG)*PGSQ(LG)*C2*DEUPI
  1531. C cas 2D axi Laplacien Champ vitesse Fin
  1532.           ENDIF
  1533.  
  1534.  312      CONTINUE
  1535.  
  1536.          DO 316 N=1,NC
  1537.           SU(N) = SU(N) + (AIMPL-1.D0)*(U2+UR)*TN1(J,N)
  1538.  316     CONTINUE
  1539.  
  1540.           RF1(J,I,1)=RF1(J,I,1)+(AIMPL*(U2+UR))
  1541.  
  1542.  311    CONTINUE
  1543.  
  1544.          DO 317 N=1,NC
  1545.           SM1(I,N)=SM1(I,N) + SU(N)
  1546.  317     CONTINUE
  1547.  
  1548.  310    CONTINUE
  1549. C...... Laplacien Fin
  1550.         ENDIF
  1551. C=======================================================================
  1552.  
  1553. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1554.         IF(TMASS) THEN
  1555. C...... Masse
  1556.         DO 210 I=1,MP
  1557.          CALL INITD(SU,NC,0.D0)
  1558.          UD=0.D0
  1559.         DO 211 J=1,NP
  1560.         U1=0.D0
  1561.         DO 212 LG=1,NPG
  1562.  
  1563.           C1=MELVA1.VELCHE(LG,NK1)
  1564.           U1=U1+WT(I,LG)*FN(J,LG)*PGSQ(LG)*C1*DEUPI*RPG(LG)
  1565.  
  1566.  
  1567.  212      CONTINUE
  1568.  
  1569.            IF(XDIAG)THEN
  1570.             UD=UD+U1
  1571.             U1=0.D0
  1572.            ELSE
  1573.             DO 216 N=1,NC
  1574.             SU(N) = SU(N) + (AIMPL-1.D0)*U1*TN1(J,N)
  1575.  216        CONTINUE
  1576.             RF1(J,I,1)=RF1(J,I,1)+AIMPL*U1
  1577.            ENDIF
  1578.  
  1579.  211    CONTINUE
  1580.  
  1581.           IF(XDIAG)THEN
  1582.            RF1(I,I,1)=RF1(I,I,1)+AIMPL*UD
  1583.            DO 218 N=1,NC
  1584.             SM1(I,N)=SM1(I,N)+ (AIMPL-1.D0)*UD*TN1(I,N)
  1585.  218       CONTINUE
  1586.           ELSE
  1587.            DO 217 N=1,NC
  1588.             SM1(I,N)=SM1(I,N)+ SU(N)
  1589.  217       CONTINUE
  1590.           ENDIF
  1591.  
  1592.  210    CONTINUE
  1593. C...... Masse Fin
  1594.         ENDIF
  1595. C=======================================================================
  1596.  
  1597. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1598.         IF(TSOUR) THEN
  1599. C...... Source
  1600.         DO 610 I=1,MP
  1601.           C1=1.D0
  1602.          DO 617 N=1,NC
  1603.           U4=0.D0
  1604.           DO 615 LG=1,NPG
  1605.           IF(TECHI)THEN
  1606.           C1=MELVA1.VELCHE(LG,NK1)
  1607.           ENDIF
  1608.           C4=MELVA4.VELCHE((N-1)*NPG+LG,NK4)
  1609.           U4=U4+WS(I,LG)*PGSQ(LG)*C4*C1*DEUPI*RPG(LG)
  1610.  615      CONTINUE
  1611.           SM1(I,N)=SM1(I,N)+ U4
  1612.  617     CONTINUE
  1613.  610    CONTINUE
  1614. C...... Source Fin
  1615.         ENDIF
  1616. C=======================================================================
  1617.  
  1618.  
  1619. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  1620. C ...... Chargement Rigidite ou Matrik
  1621.       IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN)THEN
  1622. C Cas RIGIDITE
  1623.          IF(XRIG)THEN
  1624. *          XMATRI=IMATTT(KE)
  1625.           DO     I=1,MP
  1626.           DO     J=1,NP
  1627.           RE(I,J,ke)=RF1(J,I,1)
  1628.           ENDDO
  1629.           ENDDO
  1630. *          SEGDES XMATRI
  1631.          ELSE
  1632. C Cas MATRIK
  1633.           DO     N=1,NBME
  1634.           JMATR1=JRIGEL(4,NMATR0+N)
  1635.           IPM4=JMATR1.LIZAFM(L,1)
  1636.           DO     I=1,NP
  1637.           DO     J=1,NP
  1638.           IPM4.AM(KE,J,I)=RF1(J,I,1)
  1639.           ENDDO
  1640.           ENDDO
  1641.           ENDDO
  1642.          ENDIF
  1643.       ENDIF
  1644. C ...... Chargement Second membre
  1645.         DO     I=1,NP
  1646.          I1=LECT(IPT1.NUM(I,KE))
  1647.         DO     N=1,NC
  1648.          MPOVA1.VPOCHA(I1,N)=MPOVA1.VPOCHA(I1,N)+SM1(I,N)
  1649.         ENDDO
  1650.         ENDDO
  1651. C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  1652.  
  1653.  108    CONTINUE
  1654.  
  1655.       IF(TDFDT.OR.TMASS.OR.TCONV)THEN
  1656.          SEGSUP MCHAM1,MELVA1
  1657.       ENDIF
  1658.  
  1659.       IF(TSOUR)THEN
  1660.          SEGSUP MCHAM4,MELVA4
  1661.       ENDIF
  1662.  
  1663.       IF(TLAPN.OR.TCONV)THEN
  1664.          SEGSUP MCHAM2,MELVA2
  1665.       ENDIF
  1666.  
  1667.       IF(TCONV)THEN
  1668.          SEGSUP MCHAM3,MELVA3
  1669.       ENDIF
  1670.  
  1671.       NUTOEL=NUTOEL+NBEL
  1672.  
  1673.       SEGDES IPT1,IPT2
  1674.  
  1675.       IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN.OR.TKBBT)THEN
  1676. C Cas RIGIDITE
  1677.       IF(XRIG)THEN
  1678.        SEGDES xMATRI
  1679.       ELSE
  1680. C Cas MATRIK
  1681.        SEGDES IPM1
  1682.        IF(NBME.GE.2)SEGDES IPM2
  1683.        IF(NBME.GE.3)SEGDES IPM3
  1684.       ENDIF
  1685.       ENDIF
  1686.  
  1687.       SEGSUP IZFFM,IZHR,IZF1,IZH2
  1688.       SEGSUP SAJT
  1689.  
  1690.  101  CONTINUE
  1691.  
  1692.       IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN)THEN
  1693.       IF(.NOT.XRIG)THEN
  1694.       DO 141 M=1,NBME
  1695.       JMATRI=JRIGEL(4,NMATR0+M)
  1696.       SEGDES JMATRI
  1697.  141  CONTINUE
  1698.       ENDIF
  1699.       ENDIF
  1700.  
  1701. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1702. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1703. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  1704.       ELSEIF(TVITP)THEN
  1705.  
  1706.       CALL KRIPAD(MELEMS,MLENTI)
  1707.       SEGDES MELEMS
  1708.  
  1709.       NUTOEL=0
  1710.       SEGACT MELEME,MELEM2
  1711.       NBSOUS=LISOUS(/1)
  1712.       IF(NBSOUS.EQ.0)NBSOUS=1
  1713.  
  1714. C Cas RIGIDITE Pleine
  1715.        IF(XRIG)THEN
  1716.          NRIGE=8
  1717.          NRI=IRIGEL(/2)
  1718.          NRIGEL=NBSOUS+NRI
  1719.          SEGADJ MRIGID
  1720. c     write(6,*)' NRIGE,NRIGEL,MRIGID=',NRIGE,NRIGEL,MRIGID
  1721.  
  1722.        ELSE
  1723. C Cas MATRIK Pleine
  1724.          NRIGE=7
  1725.          NKID =9
  1726.          NKMT =7
  1727.          NMATR0=JRIGEL(/2)
  1728.          NMATRI=NMATR0+1
  1729.          SEGADJ MATRIK
  1730.  
  1731.          NBMF=1
  1732.          IF(IHV.EQ.1)NBMF=IDIM
  1733.          SEGINI JMATRI
  1734. c        write(6,*)' KBBT JMATRI=',JMATRI,MELEMS,MELEMP
  1735.          JRIGEL(4,NMATR0+1)=JMATRI
  1736.  
  1737.         IF(IKAS.EQ.1.OR.IKAS.EQ.3)THEN
  1738.           JRIGEL(7,NMATR0+1)=-3
  1739.           IF(IKAS.EQ.3)JRIGEL(7,NMATR0+1)=4
  1740.           JRIGEL(1,NMATR0+1)=MELEME
  1741.           JRIGEL(2,NMATR0+1)=MELEM2
  1742.           KSPGP=MELEMS
  1743.           KSPGD=MELEMP
  1744.          IF(NBMF.EQ.1)THEN
  1745.           LISPRI(1)=NOMP(1)
  1746.           LJSDUA(1)=NOMD(1)
  1747.          ELSE
  1748.           DO 42 I=1,NBMF
  1749.           LISPRI(I)=NOMP(I)
  1750.           LJSDUA(I)=NOMD(I)
  1751.  42       CONTINUE
  1752.          ENDIF
  1753.         ELSEIF(IKAS.EQ.2)THEN
  1754.           JRIGEL(7,NMATR0+1)=3
  1755.           JRIGEL(1,NMATR0+1)=MELEM2
  1756.           JRIGEL(2,NMATR0+1)=MELEME
  1757.           KSPGP=MELEMP
  1758.           KSPGD=MELEMS
  1759.          IF(NBMF.EQ.1)THEN
  1760.           LISPRI(1)=NOMD(1)
  1761.           LJSDUA(1)=NOMP(1)
  1762.          ELSE
  1763.           DO 43 I=1,NBMF
  1764.           LISPRI(I)=NOMD(I)
  1765.           LJSDUA(I)=NOMP(I)
  1766.  43       CONTINUE
  1767.          ENDIF
  1768.         ELSE
  1769.          RETURN
  1770.         ENDIF
  1771.        ENDIF
  1772.  
  1773.          IF(TPROJ)JRIGEL(7,NMATR0+1)=4
  1774.  
  1775.       IF(TKBBT)SEGACT MCHEL1
  1776.         IF(TLINCO)THEN
  1777.          SEGACT MTETA1
  1778.          IF(XBDF)SEGACT MTETA2
  1779.         ENDIF
  1780.  
  1781.         IF(MAX(1,MELEM2.LISOUS(/1)).NE.MAX(1,LISOUS(/1)))THEN
  1782.         WRITE(6,*)' Geometries incompatibles dans ',nomper
  1783. C% Données incompatibles
  1784.         CALL ERREUR(22)
  1785.         RETURN
  1786.         ENDIF
  1787.  
  1788.       IF(INEFMD.EQ.2.AND.MPRE.EQ.'CENTRE'.AND.IKAS.NE.2)THEN
  1789. C CAS Stabilisation via MACRO CENTRE
  1790. c     write(6,*)' CAS Stabilisation via MACRO CENTRE '
  1791.  
  1792.        TYPE=' '
  1793.        CALL ACMO(MTABZ,'MELSTB',TYPE,MELSTB)
  1794.        TYPE=' '
  1795.        CALL ACMO(MTABZ,'MCHPOC',TYPE,MCHPOC)
  1796.  
  1797.       SEGACT MELSTB
  1798.       IF(IDIM.EQ.2)NBELEM=MELSTB.NUM(/2)/4
  1799.       IF(IDIM.EQ.3)NBELEM=MELSTB.NUM(/2)/8
  1800.       NBNN=MELSTB.NUM(/1)
  1801.       NBSOUS=0
  1802.       NBREF=0
  1803.       SEGINI MELEMA
  1804.       MELEMA.ITYPEL=MELSTB.ITYPEL
  1805.  
  1806.       NKPE=4
  1807.       IF(IDIM.EQ.3)NKPE=8
  1808.       DO 4878 k=1,NBELEM
  1809.       MI=(K-1)*NKPE+1
  1810.       DO 4879 I=1,NBNN
  1811.       MELEMA.NUM(I,K)=MELSTB.NUM(I,MI)
  1812.  4879 CONTINUE
  1813.  4878 CONTINUE
  1814.  
  1815.       BETA0=-ABS(CSTAB)
  1816.       IF(TPROJ)BETA0=ABS(CSTAB)
  1817. c     write(6,*)'TPROJ BETA0=',TPROJ,BETA0
  1818.       NK=0
  1819.       NMATR0=JRIGEL(/2)
  1820.       NMATRI=NMATR0+1
  1821.       SEGADJ MATRIK
  1822.       NBMF=1
  1823.       NBSOUS=1
  1824.       SEGINI JMATRS
  1825.       JRIGEL(4,NMATR0+1)=JMATRS
  1826.       JMATRS.KSPGP=MELEMC
  1827.       JMATRS.KSPGD=MELEMC
  1828.       JRIGEL(1,NMATR0+1)=MELEMA
  1829.       JRIGEL(2,NMATR0+1)=MELEMA
  1830.       JRIGEL(7,NMATR0+1)=0
  1831.       CALL LRCHT(MCHPOC,MPOVAL,TYPE,IGEOM)
  1832.  
  1833.  
  1834.       NBSOUS=MELSTB.LISOUS(/1)
  1835.       IF(NBSOUS.NE.0)THEN
  1836.       CALL ERREUR(5)
  1837.       ENDIF
  1838.  
  1839.       NBEL=MELEMA.NUM(/2)
  1840.       NBCI=MELSTB.NUM(/2)
  1841.       NP  =MELSTB.NUM(/1)
  1842.       MP  =NP
  1843.  
  1844.       SEGINI IZAFM
  1845.       JMATRS.LIZAFM(1,1)=IZAFM
  1846.       JMATRS.LISPRI(1)=NOMD(1)
  1847.       JMATRS.LJSDUA(1)=NOMD(1)
  1848.  
  1849.       CALL KRIPAD(MELEMC,MLENT1)
  1850.  
  1851.       DO 33 K=1,NBEL
  1852.  
  1853.       NK=NK+1
  1854.  
  1855.       DO 32 J=1,NP
  1856.       K1=MLENT1.LECT(MELEMA.NUM(J,K))
  1857.       II=J
  1858.       DO 34  I=1,NP
  1859.       U=VPOCHA(K1,I)*BETA0
  1860.       IF(I.EQ.1)U=ABS(VPOCHA(K1,I))*BETA0
  1861.       IF(II.LE.NP)THEN
  1862.       AM(K,II,J)=U
  1863.       ELSE
  1864.       AM(K,II-NP,J)=U
  1865.       ENDIF
  1866.       II=II+1
  1867.  34   CONTINUE
  1868.  32   CONTINUE
  1869.  33   CONTINUE
  1870.  
  1871.       SEGDES MELEMA,MELSTB,MELEMC,IZAFM,MPOVAL
  1872.       SEGSUP MLENT1
  1873.  
  1874. c     write(6,*)' Fin Stab '
  1875.       ENDIF
  1876.       SEGACT MELEME,MELEM2
  1877.  
  1878.       DO 201 L=1,MAX(1,LISOUS(/1))
  1879.       IPT1=MELEME
  1880.       IPT2=MELEM2
  1881.       IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  1882.       IF(MELEM2.LISOUS(/1).NE.0)IPT2=MELEM2.LISOUS(L)
  1883.       SEGACT IPT1,IPT2
  1884.  
  1885. C  /S INEFMD : Type formulation
  1886. C              INEFMD = 1 LINE,
  1887. C                     = 2 MACRO,
  1888. C                     = 3 QUADRATIQUE,
  1889. C                     = 4 LINB.
  1890.        NOM0='????????'
  1891.        IF(INEFMD.EQ.1)THEN
  1892.         IF(MPRE.EQ.'CENTRE  ')NOM0=NOMS(IPT1.ITYPEL)//'    '
  1893.         IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'P1P1'
  1894.        ELSEIF(INEFMD.EQ.2)THEN
  1895.         IF(MPRE.EQ.'CENTRE  ')NOM0=NOMS(IPT1.ITYPEL)//'    '
  1896.  
  1897. c ces elements ne marchent pas
  1898.         IF(MPRE.EQ.'CENTREP0')NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  1899.         IF(MPRE.EQ.'CENTREP1')NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  1900.  
  1901.         IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'MCF1'
  1902.        ELSEIF(INEFMD.EQ.3)THEN
  1903.         IF(MPRE.EQ.'CENTREP0')NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  1904.         IF(MPRE.EQ.'CENTREP1')NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  1905.         IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'PFP1'
  1906.        ELSEIF(INEFMD.EQ.4)THEN
  1907.         IF(MPRE.EQ.'MSOMMET ')NOM0=NOMS(IPT1.ITYPEL)//'    '
  1908.        ENDIF
  1909.        IF(NOM0.EQ.'????????')THEN
  1910. C% Le type d'element fini Vitesse/pression ne convient pas : %m1:8 %m9:16 .
  1911.           MOTERR( 1: 8) =LSOPT(INEFMD)
  1912.           MOTERR( 9:16) =MPRE
  1913.           WRITE(IOIMP,*)'Operateur : ',NOMPER
  1914.           CALL ERREUR(933)
  1915.           RETURN
  1916.         ENDIF
  1917.  
  1918. c      write(6,*)nomper,' NOM0=',nom0,
  1919. c     write(6,*)' 2eme KALPBG NOM0=',NOM0,IPT1
  1920.        CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  1921.        if(IZFFM.eq.0)return
  1922.  
  1923.       SEGACT IZFFM*MOD
  1924.       IZHR=KZHR(1)
  1925.       IZH2=KZHR(2)
  1926.  
  1927.       SEGACT IZHR*MOD,IZH2*MOD
  1928.  
  1929.       NES=GR(/1)
  1930.       NPG=GR(/3)
  1931.       IZF1=KTP(1)
  1932.       SEGACT IZF1*MOD
  1933.       NP = IPT1.NUM(/1)
  1934.       MP = IPT2.NUM(/1)
  1935.        IF(IKAS.EQ.2)THEN
  1936.         MP = IPT1.NUM(/1)
  1937.         NP = IPT2.NUM(/1)
  1938.        ENDIF
  1939.  
  1940.       NBEL=IPT1.NUM(/2)
  1941.  
  1942.       SEGINI SAJT
  1943.  
  1944. C Cas RIGIDITE
  1945.       IF(XRIG)THEN
  1946.         IRIGEL(1,NRI+L)=MELEME
  1947.         COERIG(L)=1.D0
  1948.  
  1949.         IRIGEL(7,NRI+L)=0
  1950.         IF(TCONV)IRIGEL(7,NRI+L)=2
  1951.  
  1952.         NBME=1
  1953.         IF(IHV.EQ.1)NBME=IDIM
  1954.         NLIGRP=NP
  1955.         NLIGRD=MP
  1956.         SEGINI DESCR
  1957.         IRIGEL(3,NRI+L)=DESCR
  1958.        IF(NBME.EQ.1)THEN
  1959.          DO 202 I=1,NLIGRP
  1960.         LISINC(I)=NOMP(1)
  1961.         NOELEP(I)=I
  1962.  202     CONTINUE
  1963.          DO 203 I=1,NLIGRD
  1964.         LISDUA(I)=NOMD(1)
  1965.         NOELED(I)=I
  1966.  203     CONTINUE
  1967.        ELSE
  1968.        ENDIF
  1969.         SEGDES DESCR
  1970.  
  1971.         NELRIG=NBEL
  1972.         rigrel=0
  1973.         SEGINI xMATRI
  1974.         IRIGEL(4,NRI+L)=xMATRI
  1975.         xmatri.symre=irigel(7,nri+l)
  1976. c       write(6,*)'NELRIG,IMATRI=',NELRIG,IMATRI
  1977.  
  1978. *        DO 204 K=1,NELRIG
  1979. *        SEGINI XMATRI
  1980. c       write(6,*)'NLIGRD,NLIGRP,XMATRI=',NLIGRD,NLIGRP,XMATRI
  1981. *        IMATTT(K)=XMATRI
  1982. * 204    CONTINUE
  1983.  
  1984.       ELSE
  1985. C Cas MATRIK
  1986.         NBMF=LIZAFM(/2)
  1987.         SEGINI IPM1
  1988.         LIZAFM(L,1)=IPM1
  1989.         IPM2=IPM1
  1990.         IPM3=IPM1
  1991.          IF(NBMF.GE.2)THEN
  1992.            SEGINI IPM2
  1993.            LIZAFM(L,2)=IPM2
  1994.          ENDIF
  1995.          IF(NBMF.GE.3)THEN
  1996.            SEGINI IPM3
  1997.            LIZAFM(L,3)=IPM3
  1998.          ENDIF
  1999.       ENDIF
  2000.  
  2001. C----Ro
  2002.       IK1=1
  2003.       IF(TKBBT)THEN
  2004.       MCHAM1=MCHEL1.ICHAML(L)
  2005.       SEGACT MCHAM1
  2006.  
  2007.       MELVA1=MCHAM1.IELVAL(1)
  2008.       SEGACT MELVA1
  2009.       N1PTEL=MELVA1.VELCHE(/1)
  2010.       N1EL=MELVA1.VELCHE(/2)
  2011.         IF(N1EL.EQ.1)THEN
  2012.         IK1=1
  2013.         ELSEIF(N1EL.EQ.NBEL)THEN
  2014.         IK1=0
  2015.         ENDIF
  2016.       ENDIF
  2017.  
  2018. c      write(6,*)'AVT208 NC=',NC,'IK1=',IK1,'NP=',NP,'MP=',MP,'MP1=',MP1
  2019. C===============================================
  2020.         segact mcoord
  2021.         DO 208 KE=1,NBEL
  2022.  
  2023.         NK1=KE + IK1*(1 - KE)
  2024.  
  2025.         DO     I=1,NP
  2026.         J=IPT1.NUM(I,KE)
  2027.         DO     N=1,IDIM
  2028.         XYZ(N,I)=XCOOR((J-1)*(IDIM+1)+N)
  2029.         ENDDO
  2030.         ENDDO
  2031.  
  2032.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,
  2033.      *  IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  2034.  
  2035.         CALL INITD(RF1,(NP*MP*IDIM),0.D0)
  2036. c       CALL INITD(SM1,NP,0.D0)
  2037.  
  2038. c       DO 207 I=1,NP
  2039. c        I1=MLENT1.LECT(IPT1.NUM(I,KE))
  2040. c       DO 207 N=1,NC
  2041. c        TN1(I,N)=MTETA1.VPOCHA(I1,N)
  2042. c207    CONTINUE
  2043.  
  2044. c       IF(XBDF)THEN
  2045. c        DO 206 I=1,NP
  2046. c         I2=MLENT2.LECT(IPT1.NUM(I,KE))
  2047. c        DO 206 N=1,NC
  2048. c         TN2(I,N)=MTETA2.VPOCHA(I2,N)
  2049. c206     CONTINUE
  2050. c       ENDIF
  2051.  
  2052.  
  2053. C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2054.         IF(TKBBT) THEN
  2055. C...... Matrice C Ct
  2056.  
  2057. c       write(6,*)' Calcul C Ct'
  2058.         DO     N=1,IDIM
  2059.         DO     I=1,MP
  2060.         DO 511 J=1,NP
  2061.          U1=0.D0
  2062.         DO 512 LG=1,NPG
  2063.           C1=MELVA1.VELCHE(LG,NK1)
  2064.           U1=U1+IZF1.FN(I,LG)*HR(N,J,LG)*PGSQ(LG)*DEUPI*RPG(LG)*C1
  2065.  512    CONTINUE
  2066.           RF1(J,I,N)=RF1(J,I,N)+U1
  2067.  511    CONTINUE
  2068.         ENDDO
  2069.         ENDDO
  2070. C...... Matrice C Ct Fin
  2071.         ENDIF
  2072. C=======================================================================
  2073.  
  2074. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  2075. C ...... Chargement Rigidite ou Matrik
  2076. c          write(6,*)' Chargement Rigidite ou Matrik'
  2077. C Cas RIGIDITE
  2078.          IF(XRIG)THEN
  2079. *          XMATRI=IMATTT(KE)
  2080.           DO     I=1,MP
  2081.           DO     J=1,NP
  2082.           RE(I,J,ke)=RF1(J,I,1)
  2083.           ENDDO
  2084.           ENDDO
  2085. *          SEGDES XMATRI
  2086.          ELSE
  2087. C Cas MATRIK
  2088.           DO 923 N=1,NBMF
  2089.           IPM4=LIZAFM(L,N)
  2090. c         write(6,*)'IPM4=',IPM4
  2091.           DO     I=1,MP
  2092.           DO     J=1,NP
  2093.           IPM4.AM(KE,J,I)=RF1(J,I,N)
  2094.           ENDDO
  2095.           ENDDO
  2096.  923      CONTINUE
  2097. c         write(6,*)' Fin Chargement'
  2098.          ENDIF
  2099. C ...... Chargement Second membre
  2100. c       DO 920 I=1,NP
  2101. c        I1=LECT(IPT1.NUM(I,KE))
  2102. c       DO 920 N=1,NC
  2103. c        MPOVA1.VPOCHA(I1,N)=MPOVA1.VPOCHA(I1,N)+SM1(I,N)
  2104. c920    CONTINUE
  2105. C<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  2106.  
  2107.  
  2108.  
  2109.  208    CONTINUE
  2110.  
  2111.       IF(TKBBT)THEN
  2112.          SEGSUP MCHAM1,MELVA1
  2113.       ENDIF
  2114.  
  2115.       NUTOEL=NUTOEL+NBEL
  2116.  
  2117.       SEGDES IPT1,IPT2
  2118.  
  2119.       IF(TDFDT.OR.TMASS.OR.TCONV.OR.TLAPN.OR.TKBBT)THEN
  2120. C Cas RIGIDITE
  2121.       IF(XRIG)THEN
  2122.        SEGDES xMATRI
  2123.       ELSE
  2124. C Cas MATRIK
  2125.        SEGDES IPM1
  2126.        IF(NBMF.GE.2)SEGDES IPM2
  2127.        IF(NBMF.GE.3)SEGDES IPM3
  2128.       ENDIF
  2129.       ENDIF
  2130.  
  2131.       SEGSUP IZFFM,IZHR,IZF1,IZH2
  2132.       SEGSUP SAJT
  2133.  
  2134.  201  CONTINUE
  2135.  
  2136. C Cas RIGIDITE
  2137.        IF(XRIG)THEN
  2138.        ELSE
  2139. C Cas MATRIK
  2140.         NMATRI=JRIGEL(/2)
  2141.         DO 205 I=1,NMATRI
  2142.         JMATRI=JRIGEL(4,I)
  2143.         SEGDES JMATRI
  2144.  205    CONTINUE
  2145.        ENDIF
  2146.  
  2147. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  2148. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  2149. C"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  2150.       ENDIF
  2151.  
  2152.  
  2153.       IF(TDFDT)THEN
  2154.          SEGSUP MCHEL1
  2155.       ENDIF
  2156.  
  2157.       IF(TSOUR)THEN
  2158.          SEGSUP MCHEL4
  2159.       ENDIF
  2160.  
  2161.       IF(TLAPN.OR.TCONV)THEN
  2162.          SEGSUP MCHEL2
  2163.       ENDIF
  2164.  
  2165.       IF(TCONV)THEN
  2166.          SEGSUP MCHEL3
  2167.       ENDIF
  2168.  
  2169.  
  2170.       SEGDES MCHPO1,MPOVA1
  2171.       SEGDES MELEME,MELEM2
  2172.  
  2173.       SEGSUP MLENTI
  2174.       IF(TLINCO)THEN
  2175.       SEGSUP MLENT1
  2176.        SEGDES MTETA1
  2177.        IF(XBDF)THEN
  2178.         SEGSUP MLENT2
  2179.         SEGDES MTETA2
  2180.        ENDIF
  2181.       ENDIF
  2182.  
  2183. c      write(6,*)' NINKO=',NINKO
  2184.       IF(NINKO.GE.2.AND.TLINCO)THEN
  2185.        SEGSUP MLENT3
  2186.        SEGDES MTETA3
  2187.         IF(XBDF)THEN
  2188.          SEGSUP MLENT4
  2189.          SEGDES MTETA4
  2190.         ENDIF
  2191.       ENDIF
  2192.  
  2193. C Cas RIGIDITE
  2194.       IF(XRIG)THEN
  2195. c      write(6,*)' On ecrit bien une rigidite ',MRIGID
  2196.        SEGDES MRIGID
  2197.        CALL ECROBJ('RIGIDITE',MRIGID)
  2198.       ELSE
  2199. C Cas MATRIK
  2200. c      write(6,*)' On ecrit bien un MATRIK ',MATRIK
  2201.        SEGDES MATRIK
  2202.        CALL ECROBJ('MATRIK',MATRIK)
  2203.       ENDIF
  2204.  
  2205. c     write(6,*)'On ecrit bien un CHPOINT',MCHPO1
  2206.       CALL ECROBJ('CHPOINT',MCHPO1)
  2207. C*************************************************************************
  2208.  
  2209. c     write(6,*)' FIN YTCLSF'
  2210.       RETURN
  2211.  1001 FORMAT(20(1X,I5))
  2212.  1002 FORMAT(10(1X,1PE11.4))
  2213.       END
  2214.  
  2215.  
  2216.  
  2217.  
  2218.  
  2219.  

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