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    GOUNAND   25/11/12    21:15:23     12399          
  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,1,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 7411 M=1,NC
  235.             iu = IZIPAD.LECT(MELEMC.NUM(1,I))
  236.             VPOCHA(iu,M)=IZBB.VPOCHA(I,M)
  237.  7411    CONTINUE
  238.  741  CONTINUE
  239.  
  240.       IF(INEFMD.EQ.1)GO TO 790
  241.  
  242.       SEGACT MELEME
  243.       NBSOUS=LISOUS(/1)
  244.  
  245.       DO 742 L=1,(MAX(1,NBSOUS))
  246.       IPT1=MELEME
  247.       IF(NBSOUS.NE.0)IPT1=LISOUS(L)
  248.       SEGACT IPT1
  249.  
  250.       NBELEM =IPT1.NUM(/2)
  251.       NBNN   =IPT1.NUM(/1)
  252.  
  253.       IF(IPT1.ITYPEL.EQ.6)THEN
  254. C     write(6,*)' TRI6'
  255.  
  256.       DO 643 K=1,NBELEM
  257.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  258.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  259.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  260.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  261.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  262.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  263.       DO 645 M=1,NC
  264.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  265.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  266.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  267.  645  CONTINUE
  268.  643  CONTINUE
  269.  
  270.       ELSEIF(IPT1.ITYPEL.EQ.7)THEN
  271. C     write(6,*)' TRI7'
  272.  
  273.       DO 743 K=1,NBELEM
  274.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  275.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  276.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  277.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  278.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  279.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  280.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  281.       DO 745 M=1,NC
  282.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  283.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  284.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  285.       VPOCHA(iu7,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  286.  745  CONTINUE
  287.  743  CONTINUE
  288.  
  289.       ELSEIF(IPT1.ITYPEL.EQ.11)THEN
  290. C     write(6,*)' QUA9'
  291.  
  292.       DO 943 K=1,NBELEM
  293.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  294.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  295.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  296.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  297.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  298.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  299.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  300.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  301.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  302.       DO 945 M=1,NC
  303.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  304.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  305.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  306.       VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  307.       VPOCHA(iu9,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  308.      &                                            VPOCHA(iu7,M))/4.D0
  309.  945  CONTINUE
  310.  943  CONTINUE
  311.  
  312.       ELSEIF(IPT1.ITYPEL.EQ.33)THEN
  313. C     write(6,*)' CU27'
  314.  
  315.       DO 2743 K=1,NBELEM
  316.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  317.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  318.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  319.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  320.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  321.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  322.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  323.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  324.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  325.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  326.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  327.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  328.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  329.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  330.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  331.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  332.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  333.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  334.       iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  335.       iu20= IZIPAD.LECT(IPT1.NUM(20,K))
  336.       iu21= IZIPAD.LECT(IPT1.NUM(21,K))
  337.       iu22= IZIPAD.LECT(IPT1.NUM(22,K))
  338.       iu23= IZIPAD.LECT(IPT1.NUM(23,K))
  339.       iu24= IZIPAD.LECT(IPT1.NUM(24,K))
  340.       iu25= IZIPAD.LECT(IPT1.NUM(25,K))
  341.       iu26= IZIPAD.LECT(IPT1.NUM(26,K))
  342.       iu27= IZIPAD.LECT(IPT1.NUM(27,K))
  343.       DO 2745 M=1,NC
  344.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  345.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  346.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  347.       VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  348.       VPOCHA(iu25,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  349.      &                                            VPOCHA(iu7,M))/4.D0
  350.  
  351.       VPOCHA(iu14,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M))*0.5
  352.       VPOCHA(iu16,M)=(VPOCHA(iu15,M)+VPOCHA(iu17,M))*0.5
  353.       VPOCHA(iu18,M)=(VPOCHA(iu17,M)+VPOCHA(iu19,M))*0.5
  354.       VPOCHA(iu20,M)=(VPOCHA(iu19,M)+VPOCHA(iu13,M))*0.5
  355.       VPOCHA(iu26,M)=(VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+
  356.      &                                            VPOCHA(iu19,M))/4.D0
  357.  
  358.       VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5
  359.       VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu15,M))*0.5
  360.       VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu17,M))*0.5
  361.       VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu19,M))*0.5
  362.  
  363.       VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu15,M)+
  364.      &                                            VPOCHA(iu13,M))/4.D0
  365.       VPOCHA(iu22,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu17,M)+
  366.      &                                            VPOCHA(iu15,M))/4.D0
  367.       VPOCHA(iu23,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M)+VPOCHA(iu17,M)+
  368.      &                                            VPOCHA(iu19,M))/4.D0
  369.       VPOCHA(iu24,M)=(VPOCHA(iu1 ,M)+VPOCHA(iu7,M)+VPOCHA(iu19,M)+
  370.      &                                            VPOCHA(iu13,M))/4.D0
  371.       VPOCHA(iu27,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  372.      &VPOCHA(iu7,M)+VPOCHA(iu13,M)+VPOCHA(iu15,M)+VPOCHA(iu17,M)+
  373.      &                                            VPOCHA(iu19,M))/8.D0
  374.  2745  CONTINUE
  375.  2743  CONTINUE
  376.  
  377.       ELSEIF(IPT1.ITYPEL.EQ.34)THEN
  378. C     write(6,*)' PR21'
  379.  
  380.       DO 2143 K=1,NBELEM
  381.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  382.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  383.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  384.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  385.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  386.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  387.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  388.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  389.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  390.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  391.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  392.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  393.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  394.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  395.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  396.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  397.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  398.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  399.       iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  400.       iu20= IZIPAD.LECT(IPT1.NUM(20,K))
  401.       iu21= IZIPAD.LECT(IPT1.NUM(21,K))
  402.       DO 2145 M=1,NC
  403.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  404.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  405.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  406.       VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  407.  
  408.       VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5
  409.       VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5
  410.       VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5
  411.       VPOCHA(iu20,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/3.D0
  412.  
  413.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  414.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5
  415.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5
  416.  
  417.       VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+
  418.      &                                            VPOCHA(iu10,M))/4.D0
  419.       VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+
  420.      &                                            VPOCHA(iu14,M))/4.D0
  421.       VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+
  422.      &                                            VPOCHA(iu10,M))/4.D0
  423.       VPOCHA(iu21,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  424.      &                VPOCHA(iu10,M)+VPOCHA(iu12,M)+VPOCHA(iu14,M))/6.D0
  425.  2145  CONTINUE
  426.  2143  CONTINUE
  427.  
  428.       ELSEIF(IPT1.ITYPEL.EQ.40)THEN
  429. C     write(6,*)' PR18'
  430.  
  431.       DO 1843 K=1,NBELEM
  432.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  433.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  434.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  435.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  436.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  437.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  438.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  439.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  440.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  441.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  442.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  443.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  444.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  445.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  446.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  447.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  448.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  449.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  450.       DO 1845 M=1,NC
  451.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  452.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  453.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  454.  
  455.       VPOCHA(iu11,M)=(VPOCHA(iu10,M)+VPOCHA(iu12,M))*0.5
  456.       VPOCHA(iu13,M)=(VPOCHA(iu12,M)+VPOCHA(iu14,M))*0.5
  457.       VPOCHA(iu15,M)=(VPOCHA(iu14,M)+VPOCHA(iu10,M))*0.5
  458.  
  459.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  460.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu12,M))*0.5
  461.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu14,M))*0.5
  462.  
  463.       VPOCHA(iu16,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu12,M)+
  464.      &                                            VPOCHA(iu10,M))/4.D0
  465.       VPOCHA(iu17,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu12,M)+
  466.      &                                            VPOCHA(iu14,M))/4.D0
  467.       VPOCHA(iu18,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu14,M)+
  468.      &                                            VPOCHA(iu10,M))/4.D0
  469.  1845  CONTINUE
  470.  1843  CONTINUE
  471.  
  472.       ELSEIF(IPT1.ITYPEL.EQ.35)THEN
  473. C     write(6,*)' TE15'
  474.  
  475.       DO 1543 K=1,NBELEM
  476.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  477.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  478.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  479.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  480.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  481.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  482.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  483.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  484.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  485.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  486.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  487.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  488.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  489.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  490.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  491.       DO 1545 M=1,NC
  492.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  493.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  494.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  495.       VPOCHA(iu11,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M))/3.D0
  496.  
  497.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  498.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5
  499.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5
  500.  
  501.       VPOCHA(iu12,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu10,M))/3.D0
  502.       VPOCHA(iu13,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu10,M))/3.D0
  503.       VPOCHA(iu14,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M)+VPOCHA(iu10,M))/3.D0
  504.       VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  505.      &                VPOCHA(iu10,M))/4.D0
  506.  1545  CONTINUE
  507.  1543  CONTINUE
  508.  
  509.       ELSEIF(IPT1.ITYPEL.EQ.24)THEN
  510. C     write(6,*)' TE10'
  511.  
  512.       DO 1043 K=1,NBELEM
  513.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  514.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  515.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  516.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  517.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  518.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  519.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  520.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  521.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  522.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  523.       DO 1045 M=1,NC
  524.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  525.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  526.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu1,M))*0.5
  527.  
  528.       VPOCHA(iu7 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu10,M))*0.5
  529.       VPOCHA(iu8 ,M)=(VPOCHA(iu3,M)+VPOCHA(iu10,M))*0.5
  530.       VPOCHA(iu9 ,M)=(VPOCHA(iu5,M)+VPOCHA(iu10,M))*0.5
  531.  1045  CONTINUE
  532.  1043  CONTINUE
  533.  
  534.       ELSEIF(IPT1.ITYPEL.EQ.36)THEN
  535. C     write(6,*)' PY19'
  536.  
  537.       DO 1943 K=1,NBELEM
  538.       iu1 = IZIPAD.LECT(IPT1.NUM(1,K))
  539.       iu2 = IZIPAD.LECT(IPT1.NUM(2,K))
  540.       iu3 = IZIPAD.LECT(IPT1.NUM(3,K))
  541.       iu4 = IZIPAD.LECT(IPT1.NUM(4,K))
  542.       iu5 = IZIPAD.LECT(IPT1.NUM(5,K))
  543.       iu6 = IZIPAD.LECT(IPT1.NUM(6,K))
  544.       iu7 = IZIPAD.LECT(IPT1.NUM(7,K))
  545.       iu8 = IZIPAD.LECT(IPT1.NUM(8,K))
  546.       iu9 = IZIPAD.LECT(IPT1.NUM(9,K))
  547.       iu10= IZIPAD.LECT(IPT1.NUM(10,K))
  548.       iu11= IZIPAD.LECT(IPT1.NUM(11,K))
  549.       iu12= IZIPAD.LECT(IPT1.NUM(12,K))
  550.       iu13= IZIPAD.LECT(IPT1.NUM(13,K))
  551.       iu14= IZIPAD.LECT(IPT1.NUM(14,K))
  552.       iu15= IZIPAD.LECT(IPT1.NUM(15,K))
  553.       iu16= IZIPAD.LECT(IPT1.NUM(16,K))
  554.       iu17= IZIPAD.LECT(IPT1.NUM(17,K))
  555.       iu18= IZIPAD.LECT(IPT1.NUM(18,K))
  556.       iu19= IZIPAD.LECT(IPT1.NUM(19,K))
  557.       DO 1945 M=1,NC
  558.       VPOCHA(iu2,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M))*0.5
  559.       VPOCHA(iu4,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M))*0.5
  560.       VPOCHA(iu6,M)=(VPOCHA(iu5,M)+VPOCHA(iu7,M))*0.5
  561.       VPOCHA(iu8,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M))*0.5
  562.       VPOCHA(iu14,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  563.      &                                            VPOCHA(iu7,M))/4.D0
  564.  
  565.       VPOCHA(iu9 ,M)=(VPOCHA(iu1,M)+VPOCHA(iu13,M))*0.5
  566.       VPOCHA(iu10,M)=(VPOCHA(iu3,M)+VPOCHA(iu13,M))*0.5
  567.       VPOCHA(iu11,M)=(VPOCHA(iu5,M)+VPOCHA(iu13,M))*0.5
  568.       VPOCHA(iu12,M)=(VPOCHA(iu7,M)+VPOCHA(iu13,M))*0.5
  569.  
  570.       VPOCHA(iu15,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu13,M))/3.D0
  571.       VPOCHA(iu16,M)=(VPOCHA(iu3,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0
  572.       VPOCHA(iu17,M)=(VPOCHA(iu7,M)+VPOCHA(iu5,M)+VPOCHA(iu13,M))/3.D0
  573.       VPOCHA(iu18,M)=(VPOCHA(iu7,M)+VPOCHA(iu1,M)+VPOCHA(iu13,M))/3.D0
  574.       VPOCHA(iu19,M)=(VPOCHA(iu1,M)+VPOCHA(iu3,M)+VPOCHA(iu5,M)+
  575.      &                VPOCHA(iu7,M)+VPOCHA(iu13,M))/5.D0
  576.  1945  CONTINUE
  577.  1943  CONTINUE
  578.  
  579.       ELSE
  580.       write(6,*)' KLNO : Element ',IPT1.ITYPEL,' non implemente'
  581. C%    Type d'élément incorrect
  582.       CALL ERREUR(16)
  583.       RETURN
  584.       ENDIF
  585.  742  CONTINUE
  586.  
  587.  
  588.  790  CONTINUE
  589.  
  590.       SEGSUP IZIPAD,IZIPAP
  591.       CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  592.       CALL ECROBJ('CHPOINT ',MCHPOI)
  593.  
  594.       RETURN
  595.  
  596.  
  597.       ENDIF
  598.  
  599. C------------ Cas MSOMMET Fin --------------------------------------------
  600. C------------ Cas MSOMMET Fin --------------------------------------------
  601.  
  602.  
  603.       CALL LEKTAB(MTABD,'MACRO1',MACRO1)
  604.       CALL LEKTAB(MTABD,'QUADRATI',MQUAD)
  605.       IF(IERR.NE.0)RETURN
  606.  
  607.  
  608.       KPRE=2
  609.  
  610.       MELEP1=MELEMC
  611.       IF(TYPSPG.EQ.'CENTREP0')THEN
  612.       IF(MACRO1.NE.0)MELEME=MACRO1
  613.       KPRE=3
  614.       ELSEIF(TYPSPG.EQ.'CENTREP1')THEN
  615.       KPRE=4
  616.       IF(MACRO1.NE.0)MELEME=MACRO1
  617.       CALL LEKTAB(MTABD,'ELTP1NC ',MELEP1)
  618.       ENDIF
  619.  
  620.  
  621.       CALL CRCHPT(TYPE,MELEMS,NC,1,IZD)
  622.       CALL LICHTM(IZD,IZDD,TYPC,IGEOM)
  623.  
  624.       SEGACT MELEME,MELEP1,MELEMS
  625.  
  626.       IF(IAXI.NE.0)THEN
  627.  
  628.       NPTD=MELEMS.NUM(/2)
  629.       RMINS=XGRAND
  630.       DO 232 I=1,NPTD
  631.       J=MELEMS.NUM(1,I)
  632.       R=XCOOR((J-1)*(IDIM+1)    +1)
  633.       R=ABS(R)
  634.       IF(R.LT.RMINS)RMINS=R
  635.  232  CONTINUE
  636.  
  637.       RMIN=XGRAND
  638.       DO 314 I=1,N
  639.       J=IGEOMB.NUM(1,I)
  640.       R=XCOOR((J-1)*(IDIM+1)    +1)
  641.       R=ABS(R)
  642.       IF(R.LT.RMIN)RMIN=R
  643.  314  CONTINUE
  644.       DR=1.2D0*(RMIN-RMINS)
  645.       DR=ABS(DR)
  646.       dr=max(xpetit,dr)
  647.  
  648.       DO 315 I=1,N
  649.          J=IGEOMB.NUM(1,I)
  650.          R=XCOOR((J-1)*(IDIM+1)    +1)
  651.          R=ABS(R)
  652.          DO 3151 L=1,NC
  653.             MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)*(R + DR*EXP(-(R/DR)))
  654.  3151    CONTINUE
  655.  315  CONTINUE
  656.       DR=RMIN-RMINS
  657.       if (abs(dr).lt.xpetit) dr=xpetit
  658.       ELSE
  659.       DO 316 I=1,N
  660.          DO 3161 L=1,NC
  661.             MPOVA3.VPOCHA(I,L)=IZBB.VPOCHA(I,L)
  662.  3161    CONTINUE
  663.  316  CONTINUE
  664.       ENDIF
  665.  
  666.       NBSOUS=LISOUS(/1)
  667.       IF(NBSOUS.EQ.0)NBSOUS=1
  668.  
  669.       DO 350 N=1,NC
  670.       NK=0
  671.       DO 1 L=1,NBSOUS
  672.       IPT1=MELEME
  673.       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  674.       SEGACT IPT1
  675.       NP=IPT1.NUM(/1)
  676.       NEL=IPT1.NUM(/2)
  677.  
  678.       NOM0=NOMS(IPT1.ITYPEL)//'    '
  679.  
  680.       IF(MQUAD.NE.0)THEN
  681.       IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  682.       IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'PRP0'
  683.       IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'PRP1'
  684.       ELSEIF(MACRO1.NE.0)THEN
  685.       IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'    '
  686.       IF(KPRE.EQ.3)NOM0=NOMS(IPT1.ITYPEL)//'MCP0'
  687.       IF(KPRE.EQ.4)NOM0=NOMS(IPT1.ITYPEL)//'MCP1'
  688.       ELSE
  689.       IF(KPRE.EQ.2)NOM0=NOMS(IPT1.ITYPEL)//'    '
  690.       ENDIF
  691.  
  692.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  693. C     write(6,*)' NOM0=',nom0,kpre,IZFFM
  694.  
  695.       IF(IZFFM.EQ.0)THEN
  696. C%    Type d'élément incorrect
  697.       CALL ERREUR(16)
  698.       RETURN
  699.       ENDIF
  700.  
  701.       SEGACT IZFFM*MOD
  702.       IZHR=KZHR(1)
  703.       SEGACT IZHR*MOD
  704.       NPG=FN(/2)
  705.       NES=GR(/1)
  706.       IZF1=KTP(1)
  707.       SEGACT IZF1*MOD
  708.       MP1=IZF1.FN(/1)
  709.       NPGP=IZF1.FN(/2)
  710.  
  711.       DO 10 K=1,NEL
  712.       NK=NK+1
  713.       DO 12 I=1,NP
  714.          J=IPT1.NUM(I,K)
  715.          DO 121 M=1,IDIM
  716.             XYZ(M,I)=XCOOR((J-1)*(IDIM+1)    +M)
  717.  121     CONTINUE
  718.  12   CONTINUE
  719.  
  720.       CALL CALJBR
  721.      &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  722.  
  723.       DO 35 I=1,NP
  724.       IU=IZIPAD.LECT(IPT1.NUM(I,K))
  725.       UU=0.D0
  726.       DD=0.D0
  727.       DO 340 LL=1,NPG
  728.       VL=0.D0
  729.       DO 34 J=1,MP1
  730.       KK=IZIPAP.LECT(MELEP1.NUM(J,NK))
  731.       VL=VL+IZF1.FN(J,LL)*MPOVA3.VPOCHA(KK,N)
  732.  34   CONTINUE
  733.       DD=DD+FN(I,LL)*PGSQ(LL)*DEUPI
  734.       UU=UU+VL*FN(I,LL)*PGSQ(LL)*DEUPI
  735.  340  CONTINUE
  736.       VPOCHA(IU,N)=VPOCHA(IU,N)+UU
  737.       IZDD.VPOCHA(IU,N)=IZDD.VPOCHA(IU,N)+DD
  738.    35 CONTINUE
  739.  
  740.  10   CONTINUE
  741.  1    CONTINUE
  742.  
  743.       NPTD=VPOCHA(/1)
  744.       DO 13 I=1,NPTD
  745.       VPOCHA(I,N)=VPOCHA(I,N)/IZDD.VPOCHA(I,1)
  746.  13   CONTINUE
  747.  
  748.       IF(IAXI.NE.0)THEN
  749.       DO 132 I=1,NPTD
  750.       J=MELEMS.NUM(1,I)
  751.       R=XCOOR((J-1)*(IDIM+1)    +1)
  752.       VPOCHA(I,N)=VPOCHA(I,N)/(R + DR*EXP(-(R/DR)))
  753.  132  CONTINUE
  754.       ENDIF
  755.  
  756.  350  CONTINUE
  757.  
  758.       SEGSUP MPOVA3
  759. C
  760.       SEGSUP IZIPAD,IZIPAP,IZFFM,IZHR,IZF1,IZD,IZDD
  761.  
  762.  360  CONTINUE
  763.       CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  764.       CALL ECROBJ('CHPOINT ',MCHPOI)
  765.  
  766.       RETURN
  767.  
  768.  1001 FORMAT(20(1X,I5))
  769.  1002 FORMAT(10(1X,1PE11.4))
  770.  1008 FORMAT(10(1X,A8))
  771.  9999 CONTINUE
  772.       END
  773.  
  774.  

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