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    CB215821  26/08/24    21:17:20     12622          
  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 1003 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.  1003 CONTINUE
  115.  10   CONTINUE
  116.  
  117.       NBFACE =0
  118.  
  119.       DO 2 K=1,LECT(/1)
  120.       IF(LECT(K).NE.1)GO TO 2
  121.       NBFACE=NBFACE+1
  122.  2    CONTINUE
  123.  
  124. C  Tracage orientation des faces
  125.       NBSOUS=0
  126.       NBREF=0
  127.       NBNN=1
  128.       NBELEM=NBFACE
  129.       SEGINI IGEOM
  130.  
  131.       NSOUPO=1
  132.       NAT=1
  133.       NC=IDIM
  134.       N=NBFACE
  135.       SEGINI MCHPOI,MSOUPO,MPOVAL
  136.       JATTRI(1)=2
  137.       IFOPOI=IFOUR
  138.       MTYPOI=' '
  139.       MOCHDE='                                                  '
  140.       IPCHP(1)=MSOUPO
  141.       IGEOC=IGEOM
  142.       IPOVAL=MPOVAL
  143.       NOCOMP(1)='UX'
  144.       NOCOMP(2)='UY'
  145.       IF(IDIM.EQ.3)NOCOMP(3)='UZ'
  146.  
  147. C     write(6,*)'NBFACE=',NBFACE,' NBFCE=',NBFCE
  148.       NBSOUS=0
  149.       NBREF=0
  150.       NBNN=1
  151.       NBELEM=NBFACE
  152.       SEGINI MELEM1
  153.       MELEM1.ITYPEL=1
  154.       I1=0
  155.       DO 3 K=1,LECT(/1)
  156.       IF(LECT(K).NE.1)GO TO 3
  157.       I1=I1+1
  158.       MELEM1.NUM(1,I1)=K
  159.  3    CONTINUE
  160.  
  161.       SEGSUP MLENTI
  162.       CALL KRIPAD(MELEM1,MLENTI)
  163.  
  164.       NBSOUS=0
  165.       NBREF=0
  166.       NBNN=1
  167.       NBN1=0
  168.       NBELEM=NBFACE
  169.       SEGINI IPT0
  170.       IPT0.ITYPEL=1
  171.  
  172.       NBNN=3
  173.       NBN3=0
  174.       NBELEM=NBFACE
  175.       SEGINI IPT3
  176.       IPT3.ITYPEL=3
  177.  
  178.       NBNN=7
  179.       NBN7=0
  180.       NBELEM=NBFACE
  181.       SEGINI IPT7
  182.       IPT7.ITYPEL=7
  183.  
  184.       NBNN=9
  185.       NBN9=0
  186.       NBELEM=NBFACE
  187.       SEGINI IPT9
  188.       IPT9.ITYPEL=11
  189.  
  190.       NBN0=0
  191.  
  192.       SEGACT MELEMQ
  193.  
  194.       DO 51 L=1,MAX(1,MELEMQ.LISOUS(/1))
  195.       IPT1=MELEMQ
  196.       IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L)
  197.       SEGACT IPT1
  198.       NP=IPT1.NUM(/1)
  199.       NBEL=IPT1.NUM(/2)
  200.       NOM0=NOMS(IPT1.ITYPEL)//'    '
  201.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  202.       SEGACT IZFFM*MOD
  203.       IZHR=KZHR(1)
  204.       IZH2=KZHR(2)
  205.       IZF1=KTP(1)
  206.       SEGACT IZHR*MOD
  207.       NES=GR(/1)
  208.       NPG=GR(/3)
  209. C     write(6,*)' NP,NBEL=',NP,NBEL
  210.       NPFA=0
  211.       IF(NP.EQ.3)NPFA=1
  212.       IF(NP.EQ.7)NPFA=2
  213.       IF(NP.EQ.9)NPFA=3
  214.       IF(NP.EQ.27)NPFA=4
  215.       IF(NP.EQ.21)NPFA=5
  216.       IF(NP.EQ.15)NPFA=6
  217.       IF(NP.EQ.19)NPFA=7
  218. C NBPFA nb de pts face dans un element diff nb de points par face
  219.       NBPFA=KTA(NPFA,1)
  220.       DO 52 K=1,NBEL
  221.       DO 53 I=1,NBPFA
  222.       IFA=IPT1.NUM(JNF(I,NPFA),K)
  223.       IF(LECT(IFA).EQ.0)GO TO 53
  224.       NBPPFA=KNPF(I,NPFA)
  225.       IP=KNF(NBPPFA)
  226. C     write(6,*)'IPT1=',IPT1,(IPT1.NUM(ii,K),ii=1,np),' IFA=',ifa
  227.  
  228.       NBN0=NBN0+1
  229.       IGEOM.NUM(1,NBN0)=IFA
  230.       GO TO(501,503,507,509),IP
  231. C POI1
  232.  501  CONTINUE
  233.       NBN1=NBN1+1
  234.       IDC3=KTA(NPFA,3)
  235.       DO 511 J=1,NBPPFA
  236.       J1=INF(J,I+IDC3)
  237.       IPT0.NUM(J,NBN1)=IPT1.NUM(J1,K)
  238.  511  CONTINUE
  239.       GO TO 53
  240.  
  241. C SEG3
  242.  503  CONTINUE
  243.       NBN3=NBN3+1
  244.       IDC3=KTA(NPFA,3)
  245.       DO 543 II=1,NP
  246.             J1 = IPT1.NUM(II,K)
  247.             DO 553 N=1,IDIM
  248.                XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N)
  249.  553        CONTINUE
  250.  543     CONTINUE
  251.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  252.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  253.  
  254.       VPOCHA(NBN0,1)=SGN
  255.  
  256.       IF(SGN.EQ.1.D0)THEN
  257.       JDEB=1
  258.       JFIN=NBPPFA
  259.       IPAS=1
  260.       ELSE
  261.       JDEB=NBPPFA
  262.       JFIN=1
  263.       IPAS=-1
  264.       ENDIF
  265.       J0=0
  266.       DO 513 J=JDEB,JFIN,IPAS
  267.       J0=J0+1
  268.       J1=INF(J,I+IDC3)
  269.       IPT3.NUM(J0,NBN3)=IPT1.NUM(J1,K)
  270.  513  CONTINUE
  271.       GO TO 53
  272.  
  273. C TRI7
  274.  507  CONTINUE
  275.       NBN7=NBN7+1
  276.       IDC3=KTA(NPFA,3)
  277.       DO 547 II=1,NP
  278.             J1 = IPT1.NUM(II,K)
  279.             DO 557 N=1,IDIM
  280.                XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N)
  281.  557        CONTINUE
  282.  547     CONTINUE
  283.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  284.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  285.  
  286.       VPOCHA(NBN0,1)=SGN
  287.  
  288.       IF(SGN.EQ.1.D0)THEN
  289.       JDEB=2
  290.       JFIN=NBPPFA-1
  291.       IPAS=1
  292.       ELSE
  293.       JDEB=NBPPFA-1
  294.       JFIN=2
  295.       IPAS=-1
  296.       ENDIF
  297.       J0=1
  298.       DO 517 J=JDEB,JFIN,IPAS
  299.       J0=J0+1
  300.       J1=INF(J,I+IDC3)
  301.       IPT7.NUM(J0,NBN7)=IPT1.NUM(J1,K)
  302.  517  CONTINUE
  303.       J1=INF(1,I+IDC3)
  304.       IPT7.NUM(1,NBN7)=IPT1.NUM(J1,K)
  305.       J1=INF(7,I+IDC3)
  306.       IPT7.NUM(7,NBN7)=IPT1.NUM(J1,K)
  307. C     write(6,*)(IPT7.NUM(J,NBN7),j=1,NBPPFA)
  308.       GO TO 53
  309.  
  310. C QUA9
  311.  509  CONTINUE
  312.       NBN9=NBN9+1
  313.       IDC3=KTA(NPFA,3)
  314.       DO 549 II=1,NP
  315.             J1 = IPT1.NUM(II,K)
  316.             DO 559 N=1,IDIM
  317.                XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N)
  318.  559        CONTINUE
  319.  549     CONTINUE
  320.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  321.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
  322.  
  323.       VPOCHA(NBN0,1)=SGN
  324.  
  325.       IF(SGN.EQ.1.D0)THEN
  326.       JDEB=2
  327.       JFIN=NBPPFA-1
  328.       IPAS=1
  329.       ELSE
  330.       JDEB=NBPPFA-1
  331.       JFIN=2
  332.       IPAS=-1
  333.       ENDIF
  334.       J0=1
  335.       DO 519 J=JDEB,JFIN,IPAS
  336.       J0=J0+1
  337.       J1=INF(J,I+IDC3)
  338.       IPT9.NUM(J0,NBN9)=IPT1.NUM(J1,K)
  339.  519  CONTINUE
  340.       J1=INF(1,I+IDC3)
  341.       IPT9.NUM(1,NBN9)=IPT1.NUM(J1,K)
  342.       J1=INF(9,I+IDC3)
  343.       IPT9.NUM(9,NBN9)=IPT1.NUM(J1,K)
  344.       GO TO 53
  345.  
  346.  53   CONTINUE
  347.  52   CONTINUE
  348.       SEGSUP IZFFM,IZHR,IZH2,IZF1
  349.  51   CONTINUE
  350.  
  351.       NBS=0
  352.       CALL INITI(ITAB,4,0)
  353.  
  354.       IF(NBN1.NE.0)THEN
  355.       NBS=NBS+1
  356.       NBNN=1
  357.       NBELEM=NBN1
  358.       SEGADJ IPT0
  359.       ITAB(NBS)=IPT0
  360.       MENVEL=IPT0
  361.       ENDIF
  362.  
  363.       IF(NBN3.NE.0)THEN
  364.       NBS=NBS+1
  365.       NBNN=3
  366.       NBELEM=NBN3
  367.       SEGADJ IPT3
  368.       ITAB(NBS)=IPT3
  369.       MENVEL=IPT3
  370.       ENDIF
  371.  
  372.       IF(NBN7.NE.0)THEN
  373.       NBS=NBS+1
  374.       NBNN=7
  375.       NBELEM=NBN7
  376.       SEGADJ IPT7
  377.       ITAB(NBS)=IPT7
  378.       MENVEL=IPT7
  379.       ENDIF
  380.  
  381.       IF(NBN9.NE.0)THEN
  382.       NBS=NBS+1
  383.       NBNN=9
  384.       NBELEM=NBN9
  385.       SEGADJ IPT9
  386.       ITAB(NBS)=IPT9
  387.       MENVEL=IPT9
  388.       ENDIF
  389.  
  390.       IF(NBS.NE.1)THEN
  391.       NBSOUS=NBS
  392.       NBREF=0
  393.       NBNN=0
  394.       NBELEM=0
  395.       SEGINI MENVEL
  396.       DO 60 L=1,NBS
  397.       MENVEL.LISOUS(L)=ITAB(L)
  398.  60   CONTINUE
  399.       ENDIF
  400.       SEGSUP MLENTI,MELEM1
  401.  
  402. C Creation du Chamelem d'orientation
  403.       CALL KRIPAD(IGEOM,MLENTI)
  404.       SEGACT MENVEL
  405.  
  406.       DO 11 L=1,MAX(1,MENVEL.LISOUS(/1))
  407.       IPT1=MENVEL
  408.       IF(MENVEL.LISOUS(/1).NE.0)IPT1=MENVEL.LISOUS(L)
  409.       SEGACT IPT1
  410.       NP=IPT1.NUM(/1)
  411.       NBEL=IPT1.NUM(/2)
  412.  
  413.       NOM0=NOMS(IPT1.ITYPEL)//'    '
  414.       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  415.       SEGACT IZFFM*MOD
  416.       IZHR=KZHR(1)
  417.       IZH2=KZHR(2)
  418.       IZF1=KTP(1)
  419.       SEGACT IZHR*MOD,IZF1*MOD
  420.       NES=GR(/1)
  421.       NPG=GR(/3)
  422.  
  423.       IFA=NP
  424.       IF(NP.EQ.3)IFA=2
  425.  
  426.       DO 23 K=1,NBEL
  427.       I1=LECT(IPT1.NUM(IFA,K))
  428.       IF(I1.EQ.0)GO TO 23
  429.       SJ=VPOCHA(I1,1)
  430.  
  431.       DO 30 I=1,NP
  432.             J1 = IPT1.NUM(I,K)
  433.             DO 31 N=1,IDIM
  434.                XYZ(N,I) = XCOOR((J1-1)*(IDIM+1)+N)
  435.   31        CONTINUE
  436.   30     CONTINUE
  437.         CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  438.      &        NES,IDIM,NP,NPG,IAXI,AIRE,AJ,ASGN)
  439.  
  440.       DO 33 N=1,IDIM
  441. C     VPOCHA(I1,N)=AJ(N,IDIM,1)*SJ
  442.       VPOCHA(I1,N)=AJ(N,IDIM,1)
  443.  33   CONTINUE
  444.  
  445.  23   CONTINUE
  446.  
  447.  21   CONTINUE
  448.       SEGSUP IZFFM,IZHR,IZH2,IZF1
  449.  11   CONTINUE
  450.       SEGSUP MLENTI
  451. C     write(6,*)'FIN MENVLP'
  452.  
  453.       RETURN
  454.  1001 FORMAT(20(1X,I5))
  455.  1002 FORMAT(10(1X,1PE11.4))
  456.       END
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  

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