Télécharger la plaquette Cast3M


fr en

Télécharger klno.eso

Retour à la liste

Numérotation des lignes : 

klno

  1. C KLNO      SOURCE    CB215821  24/04/12    21:16:32     11897          
  2.       SUBROUTINE KLNO
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C*************************************************************************
  6. C     Operateur KLNO
  7. C
  8. C     Objet : transforme un CHAMPOINT CENTRE en un CHAMPOINT SOMMET
  9. C
  10. C     SYNTAXE : CHPS = KLNO OBJM CHPC (MOTCLE (GRAD LIMI));
  11. C
  12. C     OBJM    : Objet modèle 'Navier_Stokes'
  13. C             : a la rigueur table DOMAINE
  14. C     CHPC    : CHAMPOINT CENTRE
  15. C     CHPS    : CHAMPOINT SOMMET
  16. C
  17. C*************************************************************************
  18. -INC SMELEME
  19.       POINTEUR MELEMS.MELEME,MELEMC.MELEME,MELEP1.MELEME
  20.       POINTEUR IGEOMB.MELEME
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC CCREEL
  25. -INC SMCOORD
  26. -INC CCGEOME
  27. -INC SMMODEL
  28. -INC SMCHPOI
  29.       POINTEUR IZB.MCHPOI,IZBB.MPOVAL
  30.       POINTEUR IZD.MCHPOI,IZDD.MPOVAL
  31. -INC SMLENTI
  32.       POINTEUR IZIPAP.MLENTI,IZIPAD.MLENTI
  33. -INC SIZFFB
  34.       POINTEUR IZF1.IZFFM
  35.       DIMENSION ITABO(4)
  36.       integer IP
  37.       CHARACTER*8 TYPE,TYPC,NOM0,TYPSPG, CHAI
  38.       CHARACTER*8 LISMO(5)
  39.       DATA LISMO/'CENTRE  ','CENTREP0','CENTREP1','MSOMMET','VOLUMF  '/
  40.       IP=0
  41.       SEGACT MCOORD
  42. C***********************************************************************
  43. C**** Case VF **********************************************************
  44. C***********************************************************************
  45.       CALL QUETYP(TYPE,1,IRET)
  46.       IF(IERR.NE.0)GOTO 9999
  47.       IF(TYPE .EQ. 'MOT     ')THEN
  48.          CALL LIRCHA(CHAI,1,IRET)
  49.          IF(IERR.NE.0)GOTO 9999
  50.          IF(CHAI.EQ. 'VF  ')THEN
  51. C
  52. C           CHPOINT to project
  53. C
  54.             CALL LIROBJ('CHPOINT ',IZB,1,IRET)
  55.             CALL ACTOBJ('CHPOINT ',IZB,1)
  56.             IF(IERR.NE.0)GOTO 9999
  57.             SEGACT IZB
  58.             IF(IZB.IPCHP(/1).NE.1) THEN
  59.                CALL ERREUR(920)
  60. C           Erreur dans le partitionnement
  61.                GOTO 9999
  62.             ENDIF
  63. C
  64. C           Domain table
  65. C
  66.             CALL LIROBJ('TABLE   ',MTABD,1,IRET)
  67.             IF(IERR.NE.0)GOTO 9999
  68. C
  69. C           Gradient
  70. C
  71.             CALL LIROBJ('CHPOINT ',MCHPO1,1,IRET)
  72.             CALL ACTOBJ('CHPOINT ',MCHPO1,1)
  73.             IF(IERR.NE.0)GOTO 9999
  74. C
  75. C           Limiter
  76. C
  77.             CALL LIROBJ('CHPOINT ',MCHPO2,1,IRET)
  78.             CALL ACTOBJ('CHPOINT ',MCHPO2,1)
  79.             IF(IERR.NE.0)GOTO 9999
  80. C
  81. C           Computation
  82. C
  83.             CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD)
  84.             IF(IERR.NE.0)GOTO 9999
  85. C
  86. C           We write the result
  87. C
  88.             CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  89.             CALL ECROBJ('CHPOINT ',MCHPOI)
  90.             GOTO 9999
  91.          ELSE
  92. C
  93. C******* I apologize myself and I give back the mot
  94. C
  95.             CALL REFUS
  96.          ENDIF
  97.       ENDIF
  98.  
  99. C***********************************************************************
  100. C**** End of the case VF ***********************************************
  101. C***********************************************************************
  102. C
  103.       IAXI=0
  104.       IF(IFOMOD.EQ.0)IAXI=2
  105.  
  106.       CALL LIRCHA(CHAI,0,IRET)
  107.  
  108.       IF(IRET.EQ.0)THEN
  109.       TYPSPG='CENTRE'
  110.       ELSE
  111.       CALL REFUS
  112.       CALL LIRMOT(LISMO,5,IP,1)
  113.       IF(IP.EQ.0)RETURN
  114.       TYPSPG=LISMO(IP)
  115.       ENDIF
  116.  
  117.       IF(TYPSPG.EQ.'VOLUMF')GO TO 51
  118.  
  119.       CALL LIROBJ('CHPOINT ',IZB,1,IRETOU)
  120.       CALL ACTOBJ('CHPOINT ',IZB,1)
  121.       IF(IRETOU.EQ.0)RETURN
  122. *
  123. * Verification du CHPOINT
  124. *
  125.  
  126.       SEGACT IZB
  127.        IF(IZB.IPCHP(/1).NE.1)THEN
  128. C% Erreur dans le partitionnement
  129.         CALL ERREUR(920)
  130.         RETURN
  131.        ENDIF
  132.  
  133.  
  134.       CALL LIROBJ('MMODEL  ',MMODEL,0,IRET)
  135.       IF(IRET.EQ.1)THEN
  136.       CALL ACTOBJ('MMODEL  ',MMODEL,1)
  137. *
  138. * Verification de l'objet modele 'Navier-Stokes'
  139. *
  140. C***
  141.         N1=KMODEL(/1)
  142.         DO 41 L=1,N1
  143.         IMODEL=KMODEL(L)
  144.          IF(FORMOD(1).NE.'NAVIER_STOKES')THEN
  145.           IF(FORMOD(1).NE.'DARCY')THEN
  146. C% On veut un modèle de type %m1:16 .
  147.            MOTERR( 1:16) = 'NAVIER_STOKES   '
  148.            CALL ERREUR(719)
  149.            RETURN
  150.           ENDIF
  151.          ENDIF
  152.  41     CONTINUE
  153.  
  154.         CALL LEKMOD(MMODEL,MTABD,INEFMD)
  155. C INEFMD=1 LINE  =2 MACRO  =3 QUADRATIQUE =4 LINB
  156.       ELSE
  157.       CALL LIROBJ('TABLE   ',MTABD,1,IRET)
  158.       IF(IRET.EQ.0)RETURN
  159.       ENDIF
  160. C------------------ Traitement du cas VOLUMF ----------------------------
  161.  51   CONTINUE
  162.        IF (IP .EQ. 5) THEN
  163.         CALL LIROBJ('CHPOINT ',MCHPO1,1,IRETOU)
  164.         CALL ACTOBJ('CHPOINT ',MCHPO1,1)
  165.          IF(IRETOU.EQ.0) THEN
  166. C% Information manquante (objet CHPOINT) : pas de définition de la densité
  167.           CALL ERREUR(839)
  168.           RETURN
  169.          ENDIF
  170.         CALL LIROBJ('CHPOINT ',MCHPO2,1,IRETOU)
  171.         CALL ACTOBJ('CHPOINT ',MCHPO2,1)
  172.          IF(IRETOU.EQ.0) THEN
  173. C% Information manquante (objet CHPOINT) : pas de définition de la densité
  174.           CALL ERREUR(839)
  175.           RETURN
  176.          ENDIF
  177.         CALL RLEX(MCHPOI,IZB,MCHPO1,MCHPO2,MTABD)
  178.         GOTO 360
  179.        ENDIF
  180.  
  181. C------------------ Traitement des cas CENTRE CENTREP0 CENTREP1 ---------
  182.  52   CONTINUE
  183. C
  184.  
  185.       DEUPI=1.D0
  186.       IF(IAXI.NE.0)DEUPI=2.D0*XPI
  187.  
  188.       CALL LICHTL(IZB,IZBB,TYPC,IGEOMB)
  189.       NC=IZBB.VPOCHA(/2)
  190.       N=IZBB.VPOCHA(/1)
  191.       SEGINI MPOVA3
  192.       SEGACT IGEOMB
  193.  
  194.       CALL LEKTAB(MTABD,TYPSPG,MELEMC)
  195.       IF (IERR.NE.0) RETURN
  196.       CALL KRIPAD(IGEOMB,IZIPAP)
  197.       CALL VERPAD(IZIPAP,MELEMC,IRET)
  198.         IF(IRET.NE.0)THEN
  199. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  200.          MOTERR(1: 8) = TYPSPG
  201.          MOTERR(9:16) = 'CHPOINT '
  202.          CALL ERREUR(788)
  203.          RETURN
  204.         ENDIF
  205.  
  206.       CALL LEKTAB(MTABD,'SOMMET',MELEMS)
  207.       CALL KRIPAD(MELEMS,IZIPAD)
  208.       TYPE='SOMMET'
  209.       CALL CRCHPT(TYPE,MELEMS,NC,MCHPOI)
  210.       CALL LICHTM(MCHPOI,MPOVAL,TYPC,IGEOM)
  211.  
  212.       CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
  213.  
  214. C------------ Cas MSOMMET ------------------------------------------------
  215. C------------ Cas MSOMMET ------------------------------------------------
  216.  
  217.       IF(TYPSPG.EQ.'MSOMMET')THEN
  218.  
  219.       IF(INEFMD.EQ.2)THEN
  220.       CALL LEKTAB(MTABD,'MACRO1',MELEME)
  221.       ENDIF
  222.  
  223.       CALL VERPAD(IZIPAD,MELEMC,IRET)
  224.         IF(IRET.NE.0)THEN
  225. C     Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique
  226.          MOTERR(1: 8) = TYPSPG
  227.          MOTERR(9:16) = 'CHPOINT '
  228.          CALL ERREUR(788)
  229.          RETURN
  230.         ENDIF
  231.  
  232. C On place les valeurs aux sommets de l'élément
  233.       DO 741 I=1,N
  234.       DO 741 M=1,NC
  235.       iu = IZIPAD.LECT(MELEMC.NUM(1,I))
  236.       VPOCHA(iu,M)=IZBB.VPOCHA(I,M)
  237.  741  CONTINUE
  238.  
  239.       IF(INEFMD.EQ.1)GO TO 790
  240.  
  241.       SEGACT MELEME
  242.       NBSOUS=LISOUS(/1)
  243.  
  244.       DO 742 L=1,(MAX(1,NBSOUS))
  245.       IPT1=MELEME
  246.       IF(NBSOUS.NE.0)IPT1=LISOUS(L)
  247.       SEGACT IPT1
  248.  
  249.       NBELEM =IPT1.NUM(/2)
  250.       NBNN   =IPT1.NUM(/1)
  251.  
  252.       IF(IPT1.ITYPEL.EQ.6)THEN
  253. C     write(6,*)' TRI6'
  254.  
  255.       DO 643 K=1,NBELEM
  256.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  257.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  258.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  259.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  260.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  261.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  262.       DO 645 M=1,NC
  263.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  264.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  265.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  266.  645  CONTINUE
  267.  643  CONTINUE
  268.  
  269.       ELSEIF(IPT1.ITYPEL.EQ.7)THEN
  270. C     write(6,*)' TRI7'
  271.  
  272.       DO 743 K=1,NBELEM
  273.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  274.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  275.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  276.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  277.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  278.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  279.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  280.       DO 745 M=1,NC
  281.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  282.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  283.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  284.       VPOCHA(iu7,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  285.  745  CONTINUE
  286.  743  CONTINUE
  287.  
  288.       ELSEIF(IPT1.ITYPEL.EQ.11)THEN
  289. C     write(6,*)' QUA9'
  290.  
  291.       DO 943 K=1,NBELEM
  292.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  293.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  294.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  295.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  296.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  297.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  298.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  299.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  300.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  301.       DO 945 M=1,NC
  302.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  303.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  304.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  305.       VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  306.       VPOCHA(iu9,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  307.      &                                            VPOCHA(iu7,M))/4.D0
  308.  945  CONTINUE
  309.  943  CONTINUE
  310.  
  311.       ELSEIF(IPT1.ITYPEL.EQ.33)THEN
  312. C     write(6,*)' CU27'
  313.  
  314.       DO 2743 K=1,NBELEM
  315.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  316.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  317.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  318.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  319.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  320.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  321.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  322.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  323.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  324.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  325.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  326.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  327.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  328.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  329.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  330.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  331.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  332.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  333.       iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  334.       iu20= IZIPAD.LECT(IPT1.NUM(20,K))
  335.       iu21= IZIPAD.LECT(IPT1.NUM(21,K))
  336.       iu22= IZIPAD.LECT(IPT1.NUM(22,K))
  337.       iu23= IZIPAD.LECT(IPT1.NUM(23,K))
  338.       iu24= IZIPAD.LECT(IPT1.NUM(24,K))
  339.       iu25= IZIPAD.LECT(IPT1.NUM(25,K))
  340.       iu26= IZIPAD.LECT(IPT1.NUM(26,K))
  341.       iu27= IZIPAD.LECT(IPT1.NUM(27,K))
  342.       DO 2745 M=1,NC
  343.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  344.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  345.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  346.       VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  347.       VPOCHA(iu25,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  348.      &                                            VPOCHA(iu7,M))/4.D0
  349.  
  350.       VPOCHA(iu14,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M))*0.5
  351.       VPOCHA(iu16,M)=(VPOCHA(iu15,M)+VPOCHA(iu17,M))*0.5
  352.       VPOCHA(iu18,M)=(VPOCHA(iu17,M)+VPOCHA(iu19,M))*0.5
  353.       VPOCHA(iu20,M)=(VPOCHA(iu19,M)+VPOCHA(iu13,M))*0.5
  354.       VPOCHA(iu26,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+
  355.      &                                            VPOCHA(iu19,M))/4.D0
  356.  
  357.       VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5
  358.       VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu15,M))*0.5
  359.       VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu17,M))*0.5
  360.       VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu19,M))*0.5
  361.  
  362.       VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu15,M)+
  363.      &                                            VPOCHA(iu13,M))/4.D0
  364.       VPOCHA(iu22,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu17,M)+
  365.      &                                            VPOCHA(iu15,M))/4.D0
  366.       VPOCHA(iu23,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M)+VPOCHA(iu17,M)+
  367.      &                                            VPOCHA(iu19,M))/4.D0
  368.       VPOCHA(iu24,M)=(VPOCHA(iu1 ,M)+VPOCHA(iu7,M)+VPOCHA(iu19,M)+
  369.      &                                            VPOCHA(iu13,M))/4.D0
  370.       VPOCHA(iu27,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  371.      &VPOCHA(iu7,M)+VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+
  372.      &                                            VPOCHA(iu19,M))/8.D0
  373.  2745  CONTINUE
  374.  2743  CONTINUE
  375.  
  376.       ELSEIF(IPT1.ITYPEL.EQ.34)THEN
  377. C     write(6,*)' PR21'
  378.  
  379.       DO 2143 K=1,NBELEM
  380.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  381.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  382.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  383.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  384.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  385.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  386.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  387.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  388.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  389.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  390.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  391.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  392.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  393.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  394.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  395.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  396.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  397.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  398.       iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  399.       iu20= IZIPAD.LECT(IPT1.NUM(20,K))
  400.       iu21= IZIPAD.LECT(IPT1.NUM(21,K))
  401.       DO 2145 M=1,NC
  402.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  403.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  404.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  405.       VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  406.  
  407.       VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5
  408.       VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5
  409.       VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5
  410.       VPOCHA(iu20,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/3.D0
  411.  
  412.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  413.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5
  414.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5
  415.  
  416.       VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+
  417.      &                                            VPOCHA(iu10,M))/4.D0
  418.       VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+
  419.      &                                            VPOCHA(iu14,M))/4.D0
  420.       VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+
  421.      &                                            VPOCHA(iu10,M))/4.D0
  422.       VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  423.      &                VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/6.D0
  424.  2145  CONTINUE
  425.  2143  CONTINUE
  426.  
  427.       ELSEIF(IPT1.ITYPEL.EQ.40)THEN
  428. C     write(6,*)' PR18'
  429.  
  430.       DO 1843 K=1,NBELEM
  431.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  432.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  433.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  434.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  435.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  436.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  437.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  438.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  439.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  440.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  441.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  442.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  443.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  444.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  445.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  446.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  447.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  448.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  449.       DO 1845 M=1,NC
  450.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  451.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  452.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  453.  
  454.       VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5
  455.       VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5
  456.       VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5
  457.  
  458.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  459.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5
  460.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5
  461.  
  462.       VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+
  463.      &                                            VPOCHA(iu10,M))/4.D0
  464.       VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+
  465.      &                                            VPOCHA(iu14,M))/4.D0
  466.       VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+
  467.      &                                            VPOCHA(iu10,M))/4.D0
  468.  1845  CONTINUE
  469.  1843  CONTINUE
  470.  
  471.       ELSEIF(IPT1.ITYPEL.EQ.35)THEN
  472. C     write(6,*)' TE15'
  473.  
  474.       DO 1543 K=1,NBELEM
  475.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  476.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  477.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  478.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  479.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  480.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  481.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  482.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  483.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  484.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  485.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  486.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  487.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  488.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  489.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  490.       DO 1545 M=1,NC
  491.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  492.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  493.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  494.       VPOCHA(iu11,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  495.  
  496.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  497.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5
  498.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5
  499.  
  500.       VPOCHA(iu12,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu10,M))/3.D0
  501.       VPOCHA(iu13,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu10,M))/3.D0
  502.       VPOCHA(iu14,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu10,M))/3.D0
  503.       VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  504.      &                VPOCHA(iu10,M))/4.D0
  505.  1545  CONTINUE
  506.  1543  CONTINUE
  507.  
  508.       ELSEIF(IPT1.ITYPEL.EQ.24)THEN
  509. C     write(6,*)' TE10'
  510.  
  511.       DO 1043 K=1,NBELEM
  512.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  513.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  514.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  515.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  516.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  517.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  518.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  519.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  520.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  521.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  522.       DO 1045 M=1,NC
  523.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  524.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  525.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  526.  
  527.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  528.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5
  529.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5
  530.  1045  CONTINUE
  531.  1043  CONTINUE
  532.  
  533.       ELSEIF(IPT1.ITYPEL.EQ.36)THEN
  534. C     write(6,*)' PY19'
  535.  
  536.       DO 1943 K=1,NBELEM
  537.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  538.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  539.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  540.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  541.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  542.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  543.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  544.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  545.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  546.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  547.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  548.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  549.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  550.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  551.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  552.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  553.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  554.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  555.       iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  556.       DO 1945 M=1,NC
  557.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  558.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  559.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  560.       VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  561.       VPOCHA(iu14,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  562.      &                                            VPOCHA(iu7,M))/4.D0
  563.  
  564.       VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5
  565.       VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu13,M))*0.5
  566.       VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu13,M))*0.5
  567.       VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu13,M))*0.5
  568.  
  569.       VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu13,M))/3.D0
  570.       VPOCHA(iu16,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0
  571.       VPOCHA(iu17,M)=(VPOCHA(iu7,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0
  572.       VPOCHA(iu18,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M)+VPOCHA(iu13,M))/3.D0
  573.       VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  574.      &                VPOCHA(iu7,M)+VPOCHA(iu13,M))/5.D0
  575.  1945  CONTINUE
  576.  1943  CONTINUE
  577.  
  578.       ELSE
  579.       write(6,*)' KLNO : Element ',IPT1.ITYPEL,' non implemente'
  580. C%    Type d'élément incorrect
  581.       CALL ERREUR(16)
  582.       RETURN
  583.       ENDIF
  584.  742  CONTINUE
  585.  
  586.  
  587.  790  CONTINUE
  588.  
  589.       SEGSUP IZIPAD,IZIPAP
  590.       CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  591.       CALL ECROBJ('CHPOINT ',MCHPOI)
  592.  
  593.       RETURN
  594.  
  595.  
  596.       ENDIF
  597.  
  598. C------------ Cas MSOMMET Fin --------------------------------------------
  599. C------------ Cas MSOMMET Fin --------------------------------------------
  600.  
  601.  
  602.       CALL LEKTAB(MTABD,'MACRO1',MACRO1)
  603.       CALL LEKTAB(MTABD,'QUADRATI',MQUAD)
  604.       IF(IERR.NE.0)RETURN
  605.  
  606.  
  607.       KPRE=2
  608.  
  609.       MELEP1=MELEMC
  610.       IF(TYPSPG.EQ.'CENTREP0')THEN
  611.       IF(MACRO1.NE.0)MELEME=MACRO1
  612.       KPRE=3
  613.       ELSEIF(TYPSPG.EQ.'CENTREP1')THEN
  614.       KPRE=4
  615.       IF(MACRO1.NE.0)MELEME=MACRO1
  616.       CALL LEKTAB(MTABD,'ELTP1NC ',MELEP1)
  617.       ENDIF
  618.  
  619.  
  620.       CALL CRCHPT(TYPE,MELEMS,NC,IZD)
  621.       CALL LICHTM(IZD,IZDD,TYPC,IGEOM)
  622.  
  623.       SEGACT MELEME,MELEP1,MELEMS
  624.  
  625.       IF(IAXI.NE.0)THEN
  626.  
  627.       NPTD=MELEMS.NUM(/2)
  628.       RMINS=XGRAND
  629.       DO 232 I=1,NPTD
  630.       J=MELEMS.NUM(1,I)
  631.       R=XCOOR((J-1)*(IDIM+1)    +1)
  632.       R=ABS(R)
  633.       IF(R.LT.RMINS)RMINS=R
  634.  232  CONTINUE
  635.  
  636.       RMIN=XGRAND
  637.       DO 314 I=1,N
  638.       J=IGEOMB.NUM(1,I)
  639.       R=XCOOR((J-1)*(IDIM+1)    +1)
  640.       R=ABS(R)
  641.       IF(R.LT.RMIN)RMIN=R
  642.  314  CONTINUE
  643.       DR=1.2D0*(RMIN-RMINS)
  644.       DR=ABS(DR)
  645.       dr=max(xpetit,dr)
  646.  
  647.       DO 315 I=1,N
  648.       J=IGEOMB.NUM(1,I)
  649.       R=XCOOR((J-1)*(IDIM+1)    +1)
  650.       R=ABS(R)
  651.       DO 315 L=1,NC
  652.       MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)*(R + DR*EXP(-(R/DR)))
  653.  315  CONTINUE
  654.       DR=RMIN-RMINS
  655.       if (abs(dr).lt.xpetit) dr=xpetit
  656.       ELSE
  657.       DO 316 I=1,N
  658.       DO 316 L=1,NC
  659.       MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)
  660.  316  CONTINUE
  661.       ENDIF
  662.  
  663.       NBSOUS=LISOUS(/1)
  664.       IF(NBSOUS.EQ.0)NBSOUS=1
  665.  
  666.       DO 350 N=1,NC
  667.       NK=0
  668.       DO 1 L=1,NBSOUS
  669.       IPT1=MELEME
  670.       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  671.       SEGACT IPT1
  672.       NP=IPT1.NUM(/1)
  673.       NEL=IPT1.NUM(/2)
  674.  
  675.       NOM0=NOMS(IPT1.ITYPEL)//'    '
  676.  
  677.       IF(MQUAD.NE.0)THEN
  678.       IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  679.       IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  680.       IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  681.       ELSEIF(MACRO1.NE.0)THEN
  682.       IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'    '
  683.       IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  684.       IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  685.       ELSE
  686.       IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'    '
  687.       ENDIF
  688.  
  689.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  690. C     write(6,*)' NOM0=',nom0,kpre,IZFFM
  691.  
  692.       IF(IZFFM.EQ.0)THEN
  693. C%    Type d'élément incorrect
  694.       CALL ERREUR(16)
  695.       RETURN
  696.       ENDIF
  697.  
  698.       SEGACT IZFFM*MOD
  699.       IZHR=KZHR(1)
  700.       SEGACT IZHR*MOD
  701.       NPG=FN(/2)
  702.       NES=GR(/1)
  703.       IZF1=KTP(1)
  704.       SEGACT IZF1*MOD
  705.       MP1=IZF1.FN(/1)
  706.       NPGP=IZF1.FN(/2)
  707.  
  708.       DO 10 K=1,NEL
  709.       NK=NK+1
  710.       DO 12 I=1,NP
  711.       J=IPT1.NUM(I,K)
  712.       DO 12 M=1,IDIM
  713.       XYZ(M,I)=XCOOR((J-1)*(IDIM+1)    +M)
  714.  12   CONTINUE
  715.  
  716.       CALL CALJBR
  717.      &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  718.  
  719.       DO 35 I=1,NP
  720.       IU=IZIPAD.LECT(IPT1.NUM(I,K))
  721.       UU=0.D0
  722.       DD=0.D0
  723.       DO 340 LL=1,NPG
  724.       VL=0.D0
  725.       DO 34 J=1,MP1
  726.       KK=IZIPAP.LECT(MELEP1.NUM(J,NK))
  727.       VL=VL+IZF1.FN(J,LL)*MPOVA3.VPOCHA(KK,N)
  728.  34   CONTINUE
  729.       DD=DD+FN(I,LL)*PGSQ(LL)*DEUPI
  730.       UU=UU+VL*FN(I,LL)*PGSQ(LL)*DEUPI
  731.  340  CONTINUE
  732.       VPOCHA(IU,N)=VPOCHA(IU,N)+UU
  733.       IZDD.VPOCHA(IU,N)=IZDD.VPOCHA(IU,N)+DD
  734.    35 CONTINUE
  735.  
  736.  10   CONTINUE
  737.  1    CONTINUE
  738.  
  739.       NPTD=VPOCHA(/1)
  740.       DO 13 I=1,NPTD
  741.       VPOCHA(I,N)=VPOCHA(I,N)/IZDD.VPOCHA(I,1)
  742.  13   CONTINUE
  743.  
  744.       IF(IAXI.NE.0)THEN
  745.       DO 132 I=1,NPTD
  746.       J=MELEMS.NUM(1,I)
  747.       R=XCOOR((J-1)*(IDIM+1)    +1)
  748.       VPOCHA(I,N)=VPOCHA(I,N)/(R + DR*EXP(-(R/DR)))
  749.  132  CONTINUE
  750.       ENDIF
  751.  
  752.  350  CONTINUE
  753.  
  754.       SEGSUP MPOVA3
  755. C
  756.       SEGSUP IZIPAD,IZIPAP,IZFFM,IZHR,IZF1,IZD,IZDD
  757.  
  758.  360  CONTINUE
  759.       CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  760.       CALL ECROBJ('CHPOINT ',MCHPOI)
  761.  
  762.       RETURN
  763.  
  764.  1001 FORMAT(20(1X,I5))
  765.  1002 FORMAT(10(1X,1PE11.4))
  766.  1008 FORMAT(10(1X,A8))
  767.  9999 CONTINUE
  768.       END
  769.  
  770.  
  771.  
  772.  
  773.  
  774.  

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