Télécharger la plaquette Cast3M


fr en

Télécharger ygmv.eso

Retour à la liste

Numérotation des lignes : 

ygmv

  1. C YGMV      SOURCE    CB215821  20/11/25    13:43:56     10792          
  2.       SUBROUTINE YGMV
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C  CE SP DISCRETISE LE TERME DE SOURCE DE QDM DANS LES EQUATIONS DE
  8. C  NAVIER STOKES
  9. C    EN 2D SUR LES ELEMENTS QUA4 ET TRI3      PLAN OU AXI
  10. C    EN 3D SUR LES ELEMENTS CUB8 ET PRI6
  11. C  L OPERATEUR EST "SOUS-INTEGRE"
  12. C
  13. C  SYNTAXE :
  14. C  ---------
  15. C
  16. C         GMV TABGMV  INCO UN :
  17. C
  18. C  COEFFICIENT :
  19. C  -------------
  20. C
  21. C  TABGMV   Table contenant les entrees suivantes
  22. C
  23. C
  24. C  INCONNUES :
  25. C  -----------
  26. C
  27. C   UN                  CHAMPS DE VITESSE
  28. C
  29. C
  30. C***********************************************************************
  31.  
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMLREEL
  36.       POINTEUR MQR.MLREEL,MPR.MLREEL
  37. -INC SMEVOLL
  38.  
  39. -INC SMCOORD
  40. -INC SMLENTI
  41.       POINTEUR IZIPAD.MLENTI
  42. -INC SMELEME
  43.       POINTEUR MELEM1.MELEME,MELEMC.MELEME,MDEBI.MELEME
  44.       POINTEUR MENTR.MELEME,MSORT.MELEME
  45. -INC SMCHPOI
  46.       POINTEUR IZG1.MCHPOI,IZGG1.MPOVAL
  47.       POINTEUR IZTU1.MPOVAL,IZPP.MPOVAL
  48.       POINTEUR IZVOL.MPOVAL
  49.  
  50.  
  51. -INC SMTABLE
  52.       POINTEUR KIZG.TABLE,MTABX.MTABLE,OPTI.MTABLE
  53.       POINTEUR INCO.TABLE,KOPT.MTABLE
  54.       POINTEUR MTABZ.MTABLE,MTABD.MTABLE,MTABP.MTABLE
  55.       POINTEUR MTABA.MTABLE
  56. -INC SMLMOTS
  57.       POINTEUR LINCO.MLMOTS
  58.       CHARACTER*8 NOMZ,NOMI,NOMA,TYPE,TYPC
  59.       REAL*8 XVEC1(3),XVEC2(3)
  60.       PARAMETER (NTB=1)
  61.       CHARACTER*8 LTAB(NTB)
  62.       DIMENSION KTAB(NTB)
  63.       SAVE IPAS
  64.       DATA LTAB/'KIZX    '/
  65.       DATA IPAS/0/
  66. C*****************************************************************************
  67.  
  68. CGMV
  69.       CALL LITABS(LTAB,KTAB,NTB,1,IRET)
  70.       IF(IRET.EQ.0)THEN
  71.       WRITE(6,*)' Operateur GMV '
  72.       WRITE(6,*)' On attend un ensemble de table soustypes'
  73.       RETURN
  74.       ENDIF
  75.       MTABX=KTAB(1)
  76.       SEGACT MTABX
  77.  
  78. C*****************************************************************************
  79. C OPTIONS
  80. C CES PARAMETRES SONT INITIALISES POUR ETRE EN DECENTRE ET NE PAS AVOIR DE
  81. C POROSITE :
  82.  
  83.       IOP4=0
  84.       IAXI=0
  85.       IF(IFOMOD.EQ.0)IAXI=2
  86.       CALL LEKTAB(MTABX,'KOPT',OPTI)
  87.       IF(OPTI.NE.0)THEN
  88.       SEGACT OPTI
  89.       TYPE=' '
  90.       CALL ACMO(OPTI,'POROSITE',TYPE,MCHPOI)
  91.       IF(TYPE.EQ.'CHPOINT ')THEN
  92.       IOP7=1
  93.       CALL LICHT(MCHPOI,IZPORO,TYPC,IGEOM)
  94.       ENDIF
  95.       ENDIF
  96. C*****************************************************************************
  97.  
  98.       CALL ACMM(MTABX,'NOMZONE',NOMZ)
  99.       CALL LEKTAB(MTABX,'DOMZ',MTABZ)
  100.       IF(MTABZ.EQ.0)THEN
  101.       WRITE(6,*)' Operateur GMV '
  102.       WRITE(6,*)' On ne trouve pas l''indice DOMZ ? '
  103.       GO TO 90
  104.       ENDIF
  105.       SEGACT MTABZ
  106.  
  107.       CALL LEKTAB(MTABZ,'MAILLAGE',MELEME)
  108.       IF(MELEME.EQ.0)GO TO 90
  109.       SEGACT MELEME
  110.  
  111.  
  112.       CALL LEKTAB(MTABZ,'XXVOLUM',MCHPOI)
  113.       IF(MCHPOI.EQ.0)GO TO 90
  114.       CALL LICHT(MCHPOI,IZVOL,TYPC,IGEOM)
  115.  
  116. C***
  117.  
  118.       TYPE='LISTMOTS'
  119.       CALL ACMO(MTABX,'LISTINCO',TYPE,LINCO)
  120.       SEGACT LINCO
  121.  
  122.       CALL ACME(MTABX,'IARG',IARG)
  123.  
  124.       IF(IARG.NE.1)THEN
  125.       WRITE(6,*)' Operateur GMV '
  126.       WRITE(6,*)' Nombre d''arguments ( ',IARG,' ) incorrect '
  127.       RETURN
  128.       ENDIF
  129.  
  130.       TYPE=' '
  131.       CALL ACMO(MTABX,'ARG1',TYPE,MTABA)
  132.       IF(TYPE.NE.'TABLE')THEN
  133.       WRITE(6,*)' Operateur GMV '
  134.       WRITE(6,*)
  135.      &' LE TYPE DE L''ARGUMENT (',TYPE,') N EST PAS CONVENABLE'
  136.       WRITE(6,*)' On attend une table '
  137.       RETURN
  138.       ELSE
  139.       SEGACT MTABA
  140.  
  141.       TYPE=' '
  142.       CALL ACMO(MTABA,'DIR',TYPE,IPQ)
  143.  
  144.       IF(TYPE.NE.'POINT')THEN
  145.       WRITE(6,*)' Operateur GMV '
  146.       WRITE(6,*)' Entree DIR erronee '
  147.       RETURN
  148.       ELSE
  149.       XVEC1(1)=XCOOR((IPQ-1)*(IDIM+1)    +1)
  150.       XVEC1(2)=XCOOR((IPQ-1)*(IDIM+1)    +2)
  151.       XNN=XVEC1(1)*XVEC1(1)+XVEC1(2)*XVEC1(2)
  152.       IF(IDIM.EQ.3)THEN
  153.       XVEC1(3)=XCOOR((IPQ-1)*(IDIM+1)    +3)
  154.       XNN=XNN+XVEC1(3)*XVEC1(3)
  155.       ENDIF
  156.       XVEC2(1)=XVEC1(1)/XNN
  157.       XVEC2(2)=XVEC1(2)/XNN
  158.       IF(IDIM.EQ.3)XVEC2(3)=XVEC1(3)/XNN
  159.  
  160.       ENDIF
  161.  
  162.       TYPE=' '
  163.       CALL ACMO(MTABA,'IMPR',TYPE,IRET)
  164.       IF(TYPE.NE.'ENTIER')THEN
  165.       IMPR=0
  166.       ELSE
  167.       CALL ACME(MTABA,'IMPR',IMPR)
  168.       ENDIF
  169.  
  170.       TYPE=' '
  171.       CALL ACMO(MTABA,'KIMP',TYPE,IRET)
  172.       IF(TYPE.NE.'FLOTTANT')THEN
  173.       IKIMP=0
  174.       ELSE
  175.       IKIMP=1
  176.       CALL ACMF(MTABA,'KIMP',AKIMP)
  177.       ENDIF
  178.  
  179.       IF(IKIMP.EQ.0)THEN
  180.  
  181.         TYPE=' '
  182.         CALL ACMO(MTABA,'K0',TYPE,IRET)
  183.         IF(TYPE.NE.'FLOTTANT')THEN
  184.         AK0=1.
  185.         CALL ECMF(MTABA,'K0',AK0)
  186.         ELSE
  187.         CALL ACMF(MTABA,'K0',AK0)
  188.         ENDIF
  189.  
  190.         TYPE=' '
  191.         CALL ACMO(MTABA,'OMEGA',TYPE,IRET)
  192.         IF(TYPE.NE.'FLOTTANT')THEN
  193.         W1=0.1
  194.         CALL ECMF(MTABA,'OMEGA',W1)
  195.         ELSE
  196.         CALL ACMF(MTABA,'OMEGA',W1)
  197.         ENDIF
  198.  
  199.         TYPE=' '
  200.         CALL ACMO(MTABA,'GMV',TYPE,MEVOLL)
  201.         IF(TYPE.EQ.'EVOLUTIO')THEN
  202.         SEGACT MEVOLL
  203.         KEVOLL=IEVOLL(1)
  204.         SEGACT KEVOLL
  205.         MQR=IPROGX
  206.         MPR=IPROGY
  207.         SEGDES KEVOLL,MEVOLL
  208.         ELSE
  209.         WRITE(6,*)' Operateur GMV '
  210.         WRITE(6,*)' Entree GMV erronee '
  211.         WRITE(6,*)' On attend un type EVOLUTION'
  212.         RETURN
  213.         ENDIF
  214.  
  215.       ENDIF
  216.  
  217.  
  218.       TYPE=' '
  219.       CALL ACMO(MTABA,'LDEBIT',TYPE,MDEBI)
  220.       IF(TYPE.NE.'MAILLAGE')THEN
  221.       WRITE(6,*)' Operateur GMV '
  222.       WRITE(6,*)' Entree LDEBIT erronee '
  223.       WRITE(6,*)' On attend un type MAILLAGE'
  224.       RETURN
  225.       ENDIF
  226.  
  227.       TYPE=' '
  228.       CALL ACMO(MTABA,'PENTREE',TYPE,MENTR)
  229.       IF(TYPE.NE.'MAILLAGE')THEN
  230.       WRITE(6,*)' Operateur GMV '
  231.       WRITE(6,*)' Entree PENTREE erronee '
  232.       WRITE(6,*)' On attend un type MAILLAGE'
  233.       RETURN
  234.       ENDIF
  235.  
  236.       TYPE=' '
  237.       CALL ACMO(MTABA,'PSORTIE',TYPE,MSORT)
  238.       IF(TYPE.NE.'MAILLAGE')THEN
  239.       WRITE(6,*)' Operateur GMV '
  240.       WRITE(6,*)' Entree PSORTIE erronee '
  241.       WRITE(6,*)' On attend un type MAILLAGE'
  242.       RETURN
  243.       ENDIF
  244.  
  245.       ENDIF
  246. C****************** Fin lecture Table Arguments *****************
  247.  
  248.       CALL LEKTAB(MTABX,'EQEX',MTAB1)
  249.       IF(MTAB1.EQ.0)THEN
  250.       WRITE(6,*)' Operateur GMV '
  251.       WRITE(6,*)' On ne trouve pas l''indice EQEX ? '
  252.       GO TO 90
  253.       ENDIF
  254.       SEGACT MTAB1
  255.       CALL LEKTAB(MTAB1,'DOMAINE',MTABD)
  256.       IF(MTABD.EQ.0)THEN
  257.       WRITE(6,*)' Operateur GMV '
  258.       WRITE(6,*)' On ne trouve pas l''indice DOMAINE ?'
  259.       GO TO 90
  260.       ENDIF
  261.       CALL LEKTAB(MTABD,'SOMMET',MELEM1)
  262.       IF(MELEM1.EQ.0)THEN
  263.       WRITE(6,*)' Operateur GMV '
  264.       WRITE(6,*)' On ne trouve pas l''indice SOMMET ?'
  265.       GO TO 90
  266.       ENDIF
  267.  
  268.       CALL LEKTAB(MTABD,'CENTRE',MELEMC)
  269.       IF(MELEMC.EQ.0)THEN
  270.       WRITE(6,*)' Operateur GMV '
  271.       WRITE(6,*)' On ne trouve pas l''indice CENTRE ?'
  272.       GO TO 90
  273.       ENDIF
  274.  
  275.       CALL LEKTAB(MTAB1,'INCO',INCO)
  276.       IF(INCO.EQ.0)THEN
  277.       WRITE(6,*)' Operateur GMV '
  278.       WRITE(6,*)'Il n''y a pas de table INCO '
  279.       RETURN
  280.       ENDIF
  281.       SEGACT INCO
  282.  
  283.       CALL KRIPAD(MELEM1,IZIPAD)
  284.       SEGACT MELEMC
  285.       NBC=MELEMC.NUM(/2)
  286.       CALL RSETXI(IZIPAD.LECT,MELEMC.NUM,NBC)
  287.       SEGDES MELEMC
  288. C*****************************************************************************
  289.  
  290.       CALL LEKTAB(MTAB1,'KIZG',KIZG)
  291.       IF(KIZG.EQ.0)THEN
  292.       CALL CRTABL(KIZG)
  293.       CALL ECMM(KIZG,'SOUSTYPE','KIZG')
  294.       CALL ECMO(MTAB1,'KIZG','TABLE   ',KIZG)
  295.       ELSE
  296.       SEGACT KIZG
  297.       ENDIF
  298.  
  299. C VERIFICATIONS SUR LES INCONNUES
  300.       NBINC=LINCO.MOTS(/2)
  301.       IF(NBINC.NE.1)THEN
  302.       WRITE(6,*)' Operateur GMV '
  303.       WRITE(6,*)'Nombre d''inconnues incorrecte : ',NBINC,' On attend 1'
  304.       RETURN
  305.       ENDIF
  306.  
  307.       NOMI=LINCO.MOTS(1)
  308.       SEGACT INCO
  309.  
  310.       TYPE=' '
  311.       CALL ACMO(INCO,NOMI,TYPE,MCHPOI)
  312.       IF(TYPE.NE.'CHPOINT ')THEN
  313.       WRITE(6,*)' Operateur GMV '
  314.       WRITE(6,*)' L objet CHPOINT ',NOMI,' n existe pas dans la table'
  315.       RETURN
  316.       ELSE
  317.       CALL LICHT(MCHPOI,IZTU1,TYPC,IGEOM0)
  318.       ENDIF
  319.  
  320.       TYPE=' '
  321.       CALL ACMO(KIZG,NOMI,TYPE,IZG1)
  322.       IF(TYPE.NE.'CHPOINT ')THEN
  323.       NC=IZTU1.VPOCHA(/2)
  324.       TYPE='SOMMET'
  325.       CALL CRCHPT(TYPE,IGEOM0,NC,IZG1)
  326.       CALL ECMO(KIZG,NOMI,'CHPOINT ',IZG1)
  327.       ENDIF
  328.  
  329.       CALL LICHT(IZG1,IZGG1,TYPC,IGEOM)
  330.  
  331.       TYPE=' '
  332.       CALL ACMO(MTAB1,'PRESSION',TYPE,MTABP)
  333.       IF(TYPE.NE.'TABLE')THEN
  334.       WRITE(6,*)' Operateur GMV '
  335.       WRITE(6,*)' Il n''y a pas de table pression'
  336.       RETURN
  337.       ELSE
  338.       SEGACT MTABP
  339.       TYPE=' '
  340.       CALL ACMO(MTABP,'PRESSION',TYPE,MCHP)
  341.       IF(TYPE.NE.'CHPOINT')THEN
  342.       WRITE(6,*)' Operateur GMV '
  343.       WRITE(6,*)' Il n''y a pas de Champ de pression'
  344.       RETURN
  345.       ELSE
  346.       CALL LICHT(MCHP,IZPP,TYPE,IGEOMP)
  347.       IF(IZPP.EQ.0)GO TO 90
  348.       ENDIF
  349.  
  350.       ENDIF
  351.  
  352.       SEGACT MELEME,MENTR
  353.       NE=MENTR.NUM(/2)
  354.       PE=0.
  355.       DO 31 I=1,NE
  356.       I1=MENTR.NUM(1,I)
  357.       NPP1=IZIPAD.LECT(I1)
  358.       PE=PE+IZPP.VPOCHA(NPP1,1)
  359.  31   CONTINUE
  360.       PE=PE/FLOAT(NE)
  361.  
  362.       SEGACT MSORT
  363.       NS=MSORT.NUM(/2)
  364.       PS=0.
  365.       DO 32 I=1,NS
  366.       I1=MSORT.NUM(1,I)
  367.       NPP1=IZIPAD.LECT(I1)
  368.       PS=PS+IZPP.VPOCHA(NPP1,1)
  369.  32   CONTINUE
  370.       PS=PS/FLOAT(NS)
  371.       DELTAP=PS-PE
  372.  
  373.       SEGACT MDEBI
  374.       NNP=MDEBI.NUM(/1)
  375.       NNE=MDEBI.NUM(/2)
  376.       DO 33 K=1,NNE
  377.       DO 33 I=1,NNP
  378.       I1=MDEBI.NUM(I,K)
  379.       IF(IZIPAD.LECT(I1).EQ.0)THEN
  380.       WRITE(6,*)' Operateur GMV '
  381.       WRITE(6,*)' LDEBIT SPG incompatible '
  382.       RETURN
  383.       ENDIF
  384.  33   CONTINUE
  385.  
  386.       IMPRD=0
  387.       CALL FFDBIT(IZTU1,MDEBI,IZIPAD,IAXI,Q,IMPRD)
  388.  
  389.  
  390.       IF(IKIMP.EQ.0)THEN
  391.       SEGACT MQR,MPR
  392.         NPC=MPR.PROG(/1)
  393.  
  394.         CALL INTEPL(DELTAP,MQR.PROG,MPR.PROG,NPC,QTH,IRET)
  395.  
  396.       CALL ACMF(MTABA,'K0',AK0)
  397.       IF(QTH.LT.Q)THEN
  398.       AK1=AK0/(1.D0+(Q-QTH)/(Q+1.E-20))
  399.       ELSE
  400.       IF(DELTAP.GE.0)THEN
  401.       AK1=AK0*QTH/(Q+1.E-20)
  402.       ELSE
  403.       AK1=AK0*Q/(QTH+1.E-20)
  404.       ENDIF
  405.       ENDIF
  406.       AK0=W1*AK1+(1.-W1)*AK0
  407.  
  408.       ELSE
  409.         AK0=AKIMP
  410.       ENDIF
  411.  
  412.       IF(IMPR.NE.0)THEN
  413.       IMP=MOD(IPAS,IMPR)
  414.       IF(IMP.EQ.0)THEN
  415.  
  416.       IF(IKIMP.NE.0)THEN
  417.       WRITE(6,*)' GMV : CAS K IMPOSE ',AKIMP
  418.       QTH=0.
  419.       ENDIF
  420.       WRITE(6,1888) DELTAP,Q,QTH,AK0
  421.  1888 FORMAT(1X,' GMV : DELTAP=',1PE12.4,' QR=',1PE11.4,' QTh=',1PE11.4,
  422.      &' AK0=',1PE11.4)
  423.       ENDIF
  424.       ENDIF
  425.  
  426.       XVEC2(1)=XVEC2(1)*AK0
  427.       XVEC2(2)=XVEC2(2)*AK0
  428.       XVEC2(3)=XVEC2(3)*AK0
  429.       CALL ECMF(MTABA,'K0',AK0)
  430.  
  431.       NPT=IZGG1.VPOCHA(/1)
  432.  
  433.       SEGACT MELEME
  434.       NBSOUS=LISOUS(/1)
  435.       IF(NBSOUS.NE.0)THEN
  436.       WRITE(6,*)' Operateur GMV '
  437.       WRITE(6,*)
  438.      & ' La zone doit etre compose d''un seul type d''element'
  439.       RETURN
  440.       ENDIF
  441.  
  442.       SEGACT IZTU1
  443.       NBSOUS=1
  444.       NUTOEL=0
  445.  
  446.       DO 1 L=1,NBSOUS
  447.       IPT1=MELEME
  448.       IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  449.       SEGACT IPT1
  450.  
  451.       NP  =IPT1.NUM(/1)
  452.       NBEL=IPT1.NUM(/2)
  453.  
  454.       IES=IDIM
  455. C
  456.       CALL ZGMV(IPT1.NUM,NBEL,NUTOEL,NPT,IES,NP,IAXI,
  457.      & IZIPAD.LECT,XVEC2,
  458.      & IZTU1.VPOCHA,
  459.      & IZGG1.VPOCHA,
  460.      & IZVOL.VPOCHA)
  461.  
  462.       SEGDES IPT1
  463.       NUTOEL=NUTOEL+NBEL
  464.  
  465.  1    CONTINUE
  466.       SEGDES MELEME
  467.  
  468.       IF(IKIMP.EQ.0)SEGDES MPR,MQR
  469.       SEGDES IZTU1
  470.       SEGDES IZGG1
  471.       SEGDES IZVOL
  472.       SEGDES LINCO
  473.       SEGDES MTABX,MTAB1,INCO,KIZG,MTABA,MTABP,MTABD,MTABZ
  474.       SEGDES IZPP,MDEBI,MSORT,MENTR
  475.       SEGSUP IZIPAD
  476.  
  477.  89   CONTINUE
  478.       IPAS=IPAS+1
  479.       RETURN
  480.  90   CONTINUE
  481.       WRITE(6,*)' Interuption anormale de GMV'
  482.       RETURN
  483.  1002 FORMAT(10(1X,1PE11.4))
  484.       END
  485.  
  486.  
  487.  
  488.  
  489.  

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