Télécharger la plaquette Cast3M


fr en

Télécharger menvlp.eso

Retour à la liste

Numérotation des lignes : 

menvlp

  1. C MENVLP    SOURCE    FANDEUR   22/01/03    21:15:31     11136          
  2.       SUBROUTINE MENVLP(MELEMQ,MENVEL,MCHPOI,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMLENTI
  10. -INC CCGEOME
  11. -INC SIZFFB
  12.       POINTEUR IZF1.IZFFM,IZH2.IZHR
  13. -INC SMCOORD
  14. -INC SMCHPOI
  15. -INC SMELEME
  16.       POINTEUR MENVEL.MELEME,MELEMP.MELEME,MELEM1.MELEME
  17.       POINTEUR MELEMQ.MELEME
  18.       POINTEUR IPT0.MELEME,IGEOM.MELEME
  19.       CHARACTER*8 NOM0,TYPE
  20.  
  21.       DIMENSION JNF(6,7),KTA(7,3),ITAB(4)
  22.       DIMENSION KNPF(6,7),KNF(9)
  23.  
  24.       DATA KTA/
  25. C nb de faces par type d'élément
  26.      &         2, 3, 4, 6, 5, 4, 5,
  27. C numero type elt pour conectivités
  28.      &         3, 7,11,33,34,35,36,
  29. C Idc3
  30.      &         0, 2,5 ,9 ,15 ,20,24/
  31.  
  32.  
  33. C Numero des pts faces  SEG3  TRI7  QUA9  CU27  PR21  TE15  PY19
  34.  
  35.       DATA JNF/1,3,0,0,0,0,
  36.      &         2,4,6,0,0,0,              2,4,6,8,0,0,
  37.      &         25,26,21,22,23,24,        19,20,16,17,18,0,
  38.      &         12,11,13,14,0,0,          14,15,16,17,18,0/
  39.  
  40. C Nombre de points par face SEG3 TRI7  QUA9  CU27  PR21  TE15  PY19
  41.  
  42.       DATA KNPF/1,1,0,0,0,0,
  43.      &          3,3,3,0,0,0,              3,3,3,3,0,0,
  44.      &          9,9,9,9,9,9,              7,7,9,9,9,0,
  45.      &          7,7,7,7,0,0,              9,7,7,7,7,0/
  46.  
  47.       DATA KNF/1,0,2,0,0,0,3,0,4/
  48.  
  49.  
  50.       DIMENSION INF(9,29)
  51. C SEG3
  52.       DATA INF/
  53.      &  1,0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0,
  54. C TRI7
  55.      &  3,2,1,0,0,0,0,0,0, 5,4,3,0,0,0,0,0,0, 1,6,5,0,0,0,0,0,0,
  56. C QUA9
  57.      &  3,2,1,0,0,0,0,0,0, 5,4,3,0,0,0,0,0,0, 7,6,5,0,0,0,0,0,0,
  58.      &  1,8,7,0,0,0,0,0,0,
  59. C CU27
  60.      &         1,8,7,6,5,4,3,2,25,    13,14,15,16,17,18,19,20,26,
  61.      &         1,2,3,10,15,14,13,9,21,  3,4,5,11,17,16,15,10,22,
  62.      &         5,6,7,12,19,18,17,11,23,   7,8,1,9,13,20,19,12,24,
  63. C PR21
  64.      &         1,6,5,4,3,2,19,0,0,      10,11,12,13,14,15,20,0,0,
  65.      &         1,2,3,8 ,12,11,10,7,16,  3,4,5,9 ,14,13,12,8 ,17,
  66.      &         5,6,1,7,10,15,14,9 ,18,
  67. C TE15
  68.      &  1,2,3,8,10,7,12,0,0, 1,6,5,4,3,2,11,0,0, 3,4,5,9,10,8,13,0,0,
  69.      &  1,7,10,9,5,6,14,0,0,
  70. C PY19
  71.      &  1,8,7,6,5,4,3,2,14, 1,2,3,10,13,9,15,0,0, 3,4,5,11,13,10,16,0,0,
  72.      &  5,6,7,12,13,11,17,0,0,  7,8,1,9,13,12,18,0,0/
  73.  
  74. C     write(6,*)'DEBUT MENVLP'
  75.       IRET=1
  76.  
  77.       IAXI=0
  78.       IF(IFOMOD.EQ.0)IAXI=2
  79.  
  80.       JG=nbpts
  81.       SEGINI MLENTI
  82.  
  83.       NBFCE=0
  84.  
  85.       SEGACT MELEMQ
  86.  
  87.       DO 10 L=1,MAX(1,MELEMQ.LISOUS(/1))
  88.       IPT1=MELEMQ
  89.       IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L)
  90.       SEGACT IPT1
  91.       NP=IPT1.NUM(/1)
  92.       NBEL=IPT1.NUM(/2)
  93.  
  94.       NPFA=0
  95.       IF(NP.EQ.3)NPFA=1
  96.       IF(NP.EQ.7)NPFA=2
  97.       IF(NP.EQ.9)NPFA=3
  98.       IF(NP.EQ.27)NPFA=4
  99.       IF(NP.EQ.21)NPFA=5
  100.       IF(NP.EQ.15)NPFA=6
  101.       IF(NP.EQ.19)NPFA=7
  102.  
  103. C NBPFA nb de pts face dans un element diff nb de points par face
  104.       NBPFA=KTA(NPFA,1)
  105.  
  106.       DO 1 K=1,NBEL
  107.  
  108.       DO 1 I=1,NBPFA
  109.       J=JNF(I,NPFA)
  110.       IFA=IPT1.NUM(J,K)
  111.       NBFCE=NBFCE+1
  112.       LECT(IFA)=LECT(IFA)+1
  113.  1    CONTINUE
  114.  10   CONTINUE
  115.  
  116.       NBFACE =0
  117.  
  118.       DO 2 K=1,LECT(/1)
  119.       IF(LECT(K).NE.1)GO TO 2
  120.       NBFACE=NBFACE+1
  121.  2    CONTINUE
  122.  
  123. C  Tracage orientation des faces
  124.       NBSOUS=0
  125.       NBREF=0
  126.       NBNN=1
  127.       NBELEM=NBFACE
  128.       SEGINI IGEOM
  129.  
  130.       NSOUPO=1
  131.       NAT=1
  132.       NC=IDIM
  133.       N=NBFACE
  134.       SEGINI MCHPOI,MSOUPO,MPOVAL
  135.       JATTRI(1)=2
  136.       IFOPOI=IFOUR
  137.       MTYPOI=' '
  138.       MOCHDE='                                                  '
  139.       IPCHP(1)=MSOUPO
  140.       IGEOC=IGEOM
  141.       IPOVAL=MPOVAL
  142.       NOCOMP(1)='UX'
  143.       NOCOMP(2)='UY'
  144.       IF(IDIM.EQ.3)NOCOMP(3)='UZ'
  145.  
  146. C     write(6,*)'NBFACE=',NBFACE,' NBFCE=',NBFCE
  147.       NBSOUS=0
  148.       NBREF=0
  149.       NBNN=1
  150.       NBELEM=NBFACE
  151.       SEGINI MELEM1
  152.       MELEM1.ITYPEL=1
  153.       I1=0
  154.       DO 3 K=1,LECT(/1)
  155.       IF(LECT(K).NE.1)GO TO 3
  156.       I1=I1+1
  157.       MELEM1.NUM(1,I1)=K
  158.  3    CONTINUE
  159.  
  160.       SEGSUP MLENTI
  161.       CALL KRIPAD(MELEM1,MLENTI)
  162.  
  163.       NBSOUS=0
  164.       NBREF=0
  165.       NBNN=1
  166.       NBN1=0
  167.       NBELEM=NBFACE
  168.       SEGINI IPT0
  169.       IPT0.ITYPEL=1
  170.  
  171.       NBNN=3
  172.       NBN3=0
  173.       NBELEM=NBFACE
  174.       SEGINI IPT3
  175.       IPT3.ITYPEL=3
  176.  
  177.       NBNN=7
  178.       NBN7=0
  179.       NBELEM=NBFACE
  180.       SEGINI IPT7
  181.       IPT7.ITYPEL=7
  182.  
  183.       NBNN=9
  184.       NBN9=0
  185.       NBELEM=NBFACE
  186.       SEGINI IPT9
  187.       IPT9.ITYPEL=11
  188.  
  189.       NBN0=0
  190.  
  191.       SEGACT MELEMQ
  192.  
  193.       DO 51 L=1,MAX(1,MELEMQ.LISOUS(/1))
  194.       IPT1=MELEMQ
  195.       IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L)
  196.       SEGACT IPT1
  197.       NP=IPT1.NUM(/1)
  198.       NBEL=IPT1.NUM(/2)
  199.       NOM0=NOMS(IPT1.ITYPEL)//'    '
  200.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  201.       SEGACT IZFFM*MOD
  202.       IZHR=KZHR(1)
  203.       IZH2=KZHR(2)
  204.       IZF1=KTP(1)
  205.       SEGACT IZHR*MOD
  206.       NES=GR(/1)
  207.       NPG=GR(/3)
  208. C     write(6,*)' NP,NBEL=',NP,NBEL
  209.       NPFA=0
  210.       IF(NP.EQ.3)NPFA=1
  211.       IF(NP.EQ.7)NPFA=2
  212.       IF(NP.EQ.9)NPFA=3
  213.       IF(NP.EQ.27)NPFA=4
  214.       IF(NP.EQ.21)NPFA=5
  215.       IF(NP.EQ.15)NPFA=6
  216.       IF(NP.EQ.19)NPFA=7
  217. C NBPFA nb de pts face dans un element diff nb de points par face
  218.       NBPFA=KTA(NPFA,1)
  219.       DO 52 K=1,NBEL
  220.       DO 53 I=1,NBPFA
  221.       IFA=IPT1.NUM(JNF(I,NPFA),K)
  222.       IF(LECT(IFA).EQ.0)GO TO 53
  223.       NBPPFA=KNPF(I,NPFA)
  224.       IP=KNF(NBPPFA)
  225. C     write(6,*)'IPT1=',IPT1,(IPT1.NUM(ii,K),ii=1,np),' IFA=',ifa
  226.  
  227.       NBN0=NBN0+1
  228.       IGEOM.NUM(1,NBN0)=IFA
  229.       GO TO(501,503,507,509),IP
  230. C POI1
  231.  501  CONTINUE
  232.       NBN1=NBN1+1
  233.       IDC3=KTA(NPFA,3)
  234.       DO 511 J=1,NBPPFA
  235.       J1=INF(J,I+IDC3)
  236.       IPT0.NUM(J,NBN1)=IPT1.NUM(J1,K)
  237.  511  CONTINUE
  238.       GO TO 53
  239.  
  240. C SEG3
  241.  503  CONTINUE
  242.       NBN3=NBN3+1
  243.       IDC3=KTA(NPFA,3)
  244.       DO 543 II=1,NP
  245.             J1 = IPT1.NUM(II,K)
  246.             DO 553 N=1,IDIM
  247.                XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N)
  248.  553        CONTINUE
  249.  543     CONTINUE
  250.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  251.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  252.  
  253.       VPOCHA(NBN0,1)=SGN
  254.  
  255.       IF(SGN.EQ.1.D0)THEN
  256.       JDEB=1
  257.       JFIN=NBPPFA
  258.       IPAS=1
  259.       ELSE
  260.       JDEB=NBPPFA
  261.       JFIN=1
  262.       IPAS=-1
  263.       ENDIF
  264.       J0=0
  265.       DO 513 J=JDEB,JFIN,IPAS
  266.       J0=J0+1
  267.       J1=INF(J,I+IDC3)
  268.       IPT3.NUM(J0,NBN3)=IPT1.NUM(J1,K)
  269.  513  CONTINUE
  270.       GO TO 53
  271.  
  272. C TRI7
  273.  507  CONTINUE
  274.       NBN7=NBN7+1
  275.       IDC3=KTA(NPFA,3)
  276.       DO 547 II=1,NP
  277.             J1 = IPT1.NUM(II,K)
  278.             DO 557 N=1,IDIM
  279.                XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N)
  280.  557        CONTINUE
  281.  547     CONTINUE
  282.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  283.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  284.  
  285.       VPOCHA(NBN0,1)=SGN
  286.  
  287.       IF(SGN.EQ.1.D0)THEN
  288.       JDEB=2
  289.       JFIN=NBPPFA-1
  290.       IPAS=1
  291.       ELSE
  292.       JDEB=NBPPFA-1
  293.       JFIN=2
  294.       IPAS=-1
  295.       ENDIF
  296.       J0=1
  297.       DO 517 J=JDEB,JFIN,IPAS
  298.       J0=J0+1
  299.       J1=INF(J,I+IDC3)
  300.       IPT7.NUM(J0,NBN7)=IPT1.NUM(J1,K)
  301.  517  CONTINUE
  302.       J1=INF(1,I+IDC3)
  303.       IPT7.NUM(1,NBN7)=IPT1.NUM(J1,K)
  304.       J1=INF(7,I+IDC3)
  305.       IPT7.NUM(7,NBN7)=IPT1.NUM(J1,K)
  306. C     write(6,*)(IPT7.NUM(J,NBN7),j=1,NBPPFA)
  307.       GO TO 53
  308.  
  309. C QUA9
  310.  509  CONTINUE
  311.       NBN9=NBN9+1
  312.       IDC3=KTA(NPFA,3)
  313.       DO 549 II=1,NP
  314.             J1 = IPT1.NUM(II,K)
  315.             DO 559 N=1,IDIM
  316.                XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N)
  317.  559        CONTINUE
  318.  549     CONTINUE
  319.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  320.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  321.  
  322.       VPOCHA(NBN0,1)=SGN
  323.  
  324.       IF(SGN.EQ.1.D0)THEN
  325.       JDEB=2
  326.       JFIN=NBPPFA-1
  327.       IPAS=1
  328.       ELSE
  329.       JDEB=NBPPFA-1
  330.       JFIN=2
  331.       IPAS=-1
  332.       ENDIF
  333.       J0=1
  334.       DO 519 J=JDEB,JFIN,IPAS
  335.       J0=J0+1
  336.       J1=INF(J,I+IDC3)
  337.       IPT9.NUM(J0,NBN9)=IPT1.NUM(J1,K)
  338.  519  CONTINUE
  339.       J1=INF(1,I+IDC3)
  340.       IPT9.NUM(1,NBN9)=IPT1.NUM(J1,K)
  341.       J1=INF(9,I+IDC3)
  342.       IPT9.NUM(9,NBN9)=IPT1.NUM(J1,K)
  343.       GO TO 53
  344.  
  345.  53   CONTINUE
  346.  52   CONTINUE
  347.       SEGSUP IZFFM,IZHR,IZH2,IZF1
  348.  51   CONTINUE
  349.  
  350.       NBS=0
  351.       CALL INITI(ITAB,4,0)
  352.  
  353.       IF(NBN1.NE.0)THEN
  354.       NBS=NBS+1
  355.       NBNN=1
  356.       NBELEM=NBN1
  357.       SEGADJ IPT0
  358.       ITAB(NBS)=IPT0
  359.       MENVEL=IPT0
  360.       ENDIF
  361.  
  362.       IF(NBN3.NE.0)THEN
  363.       NBS=NBS+1
  364.       NBNN=3
  365.       NBELEM=NBN3
  366.       SEGADJ IPT3
  367.       ITAB(NBS)=IPT3
  368.       MENVEL=IPT3
  369.       ENDIF
  370.  
  371.       IF(NBN7.NE.0)THEN
  372.       NBS=NBS+1
  373.       NBNN=7
  374.       NBELEM=NBN7
  375.       SEGADJ IPT7
  376.       ITAB(NBS)=IPT7
  377.       MENVEL=IPT7
  378.       ENDIF
  379.  
  380.       IF(NBN9.NE.0)THEN
  381.       NBS=NBS+1
  382.       NBNN=9
  383.       NBELEM=NBN9
  384.       SEGADJ IPT9
  385.       ITAB(NBS)=IPT9
  386.       MENVEL=IPT9
  387.       ENDIF
  388.  
  389.       IF(NBS.NE.1)THEN
  390.       NBSOUS=NBS
  391.       NBREF=0
  392.       NBNN=0
  393.       NBELEM=0
  394.       SEGINI MENVEL
  395.       DO 60 L=1,NBS
  396.       MENVEL.LISOUS(L)=ITAB(L)
  397.  60   CONTINUE
  398.       ENDIF
  399.       SEGSUP MLENTI,MELEM1
  400.  
  401. C Creation du Chamelem d'orientation
  402.       CALL KRIPAD(IGEOM,MLENTI)
  403.       SEGACT MENVEL
  404.  
  405.       DO 11 L=1,MAX(1,MENVEL.LISOUS(/1))
  406.       IPT1=MENVEL
  407.       IF(MENVEL.LISOUS(/1).NE.0)IPT1=MENVEL.LISOUS(L)
  408.       SEGACT IPT1
  409.       NP=IPT1.NUM(/1)
  410.       NBEL=IPT1.NUM(/2)
  411.  
  412.       NOM0=NOMS(IPT1.ITYPEL)//'    '
  413.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  414.       SEGACT IZFFM*MOD
  415.       IZHR=KZHR(1)
  416.       IZH2=KZHR(2)
  417.       IZF1=KTP(1)
  418.       SEGACT IZHR*MOD,IZF1*MOD
  419.       NES=GR(/1)
  420.       NPG=GR(/3)
  421.  
  422.       IFA=NP
  423.       IF(NP.EQ.3)IFA=2
  424.  
  425.       DO 23 K=1,NBEL
  426.       I1=LECT(IPT1.NUM(IFA,K))
  427.       IF(I1.EQ.0)GO TO 23
  428.       SJ=VPOCHA(I1,1)
  429.  
  430.       DO 30 I=1,NP
  431.             J1 = IPT1.NUM(I,K)
  432.             DO 31 N=1,IDIM
  433.                XYZ(N,I) = XCOOR((J1-1)*(IDIM+1)+N)
  434.   31        CONTINUE
  435.   30     CONTINUE
  436.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  437.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,ASGN)
  438.  
  439.       DO 33 N=1,IDIM
  440. C     VPOCHA(I1,N)=AJ(N,IDIM,1)*SJ
  441.       VPOCHA(I1,N)=AJ(N,IDIM,1)
  442.  33   CONTINUE
  443.  
  444.  23   CONTINUE
  445.  
  446.  21   CONTINUE
  447.       SEGSUP IZFFM,IZHR,IZH2,IZF1
  448.  11   CONTINUE
  449.       SEGSUP MLENTI
  450. C     write(6,*)'FIN MENVLP'
  451.  
  452.       RETURN
  453.  1001 FORMAT(20(1X,I5))
  454.  1002 FORMAT(10(1X,1PE11.4))
  455.       END
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  

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