Télécharger la plaquette Cast3M


fr en

Télécharger vfsym1.eso

Retour à la liste

Numérotation des lignes : 

vfsym1

  1. C VFSYM1    SOURCE    OF166741  24/12/13    21:17:35     12097          
  2.  
  3.       SUBROUTINE VFSYM1(IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,IELTFA,
  4.      &           IMAIL,INORM,ISURF,ICHPO,ICHTE,ICHCL,ICHNE,ICHMI,
  5.      &           ICHCO,IOP,ICHGRA,MPOGRA,ICOEFF,LOGBOR,LOGCOE,LOGCCL)
  6. C
  7. C************************************************************************
  8. C
  9. C PROJET            :  CASTEM 2000
  10. C
  11. C NOM               :  NORV1
  12. C
  13. C DESCRIPTION       : Appelle par NORV
  14. C
  15. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  16. C
  17. C AUTEUR            :  C. LE POTIER, DM2S/SFME/MTMS
  18. C
  19. C************************************************************************
  20. C
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT real*8 (a-h,o-z)
  23. -INC SMLENTI
  24. -INC SMELEME
  25. -INC SMCHPOI
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMCOORD
  29. -INC SMLREEL
  30.       POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  31.      &         MELTFA.MELEME
  32.       POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  33.      & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  34.      & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL,
  35.      & MPOVCO.MPOVAL
  36.       POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  37.      &         MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,
  38.      &         MLEFA2.MLENTI,MLENCO.MLENTI
  39. -INC SMCHAML
  40.       INTEGER NBNN,NBREF,NBMAX
  41.  
  42. C**** Variable de SMLENTI, SMCHPOI
  43. C
  44.       INTEGER JG, N, NC,  NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  45. C
  46. C**** Les includes
  47. C
  48.       INTEGER I1,ICOMP,ICOMGR,IGEOM
  49.      &     ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  50.      &     ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF
  51.      &     ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  52.      &     ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  53.      &     ,NLS1,NLS2,NLFCL
  54.      &     ,ISOUS,IELEM,INOEUD,ICELL
  55.       INTEGER ICEN2
  56.       REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2
  57.      &     ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY,
  58.      &     PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2,
  59.      &     VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2,
  60.      &     TRD1,TRD2,TRG,TRD
  61.       REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  62.      & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X,
  63.      & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD
  64.      &  VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22
  65.      &  QIMPX,QIMPY,QIMPZ
  66.  
  67.       REAL*8 VECXG1(2),VECYG1(2)
  68.       REAL*8 VECXG2(2),VECYG2(2)
  69.       REAL*8 VECXD1(2),VECYD1(2)
  70.       REAL*8 VECXD2(2),VECYD2(2)
  71.       REAL*8 EPS
  72.       INTEGER ICRIT
  73.       CHARACTER*(4) NOMCOM(18),NOMCOM3(9)
  74.       CHARACTER*8 TYPE
  75.       INTEGER LOGBOR,LOGCOE,LOGCCL
  76. C
  77.       DATA NOMCOM  /'P1DX','P1DY',
  78.      &     'P2DX','P2DY',
  79.      &     'P3DX','P3DY',
  80.      &     'P4DX','P4DY',
  81.      &     'P5DX','P5DY',
  82.      &     'P6DX','P6DY',
  83.      &     'P7DX','P7DY',
  84.      &     'P8DX','P8DY',
  85.      &     'P9DX','P9DY'/
  86.  
  87.       DATA NOMCOM3  /'P1DX','P1DY','P1DZ',
  88.      &               'P2DX','P2DY','P2DZ',
  89.      &               'P3DX','P3DY','P3DZ'/
  90.  
  91.       INTEGER NDIM
  92.       SEGMENT MMAT1
  93.       REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  94.       INTEGER IC(NDIM)
  95.       ENDSEGMENT
  96.  
  97.       INTEGER K1,K2
  98.       SEGMENT INDICE
  99.       INTEGER NUME(K1,K2)
  100.       ENDSEGMENT
  101.       POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  102.  
  103.       SEGMENT MATRICE
  104.       REAL*8 MAT(K1,K2)
  105.       ENDSEGMENT
  106.       POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  107.  
  108.  
  109.       SEGMENT POINT2
  110.       INTEGER POINT(K3)
  111.       ENDSEGMENT
  112.       POINTEUR IPO2.POINT2
  113.  
  114.       SEGMENT MATRICE2
  115.       REAL*8 MAT2(K1,K2)
  116.       ENDSEGMENT
  117.  
  118.       SEGMENT POINT3
  119.       INTEGER POINT33(K3)
  120.       ENDSEGMENT
  121.       POINTEUR IPO3.POINT3
  122.  
  123.       SEGMENT INDICE3
  124.       INTEGER NU(K1,K2)
  125.       ENDSEGMENT
  126.       POINTEUR INDIC.INDICE3
  127.  
  128.       SEGMENT REP
  129.       INTEGER  ID(K3)
  130.       ENDSEGMENT
  131.       POINTEUR TAB.REP,INDLI.REP
  132.  
  133.       INTEGER K5
  134.       SEGMENT NBFAC
  135.       INTEGER NBFACEL(K5)
  136.       INTEGER IMELEM(K5)
  137.       ENDSEGMENT
  138.  
  139.       INTEGER K6
  140.       SEGMENT NBCOT
  141.       INTEGER NBCOTE(K6)
  142.       INTEGER IMECOTE(K6)
  143.       ENDSEGMENT
  144.  
  145.  
  146.  
  147. C
  148. C
  149. C**** Nombre total de points (HP IDIM .EQ. 2)
  150. C
  151. c      SEGACT MCOORD *MOD
  152.       IOP1 = 3
  153.       NTOT = nbpts
  154.  
  155. C
  156. C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
  157. C
  158.       CALL KRIPAD(ICEN,MLECEN)
  159. C SEGMENT INTERVENANT POUR PRENDRE EN COMPTE PLUSIEURS SOUS DOMAINES
  160.       MELEME = ICEN
  161.       NCEN=MELEME.NUM(/2)
  162.       SEGDES MELEME
  163.       K5 = NCEN
  164.       SEGINI NBFAC
  165.  
  166. C
  167. C**** Le MELEME FACE (SPG du CHPOINT dont on veux calculer le gradient)
  168. C
  169.       CALL KRIPAD(IFAC,MLEFA)
  170.       MELEME = IFAC
  171.       K6=MELEME.NUM(/2)
  172.       SEGDES MELEME
  173. c      SEGINI NBCOT
  174.  
  175.  
  176.  
  177. C
  178. C
  179.  
  180. C
  181. C**** Le MELEME SOMMET
  182. C
  183.       CALL KRIPAD(ISOMM,MLESOM)
  184. C
  185. C**** En KRIPAD
  186. C     SEGACT ISOMM
  187. C     SEGINI MLESOM
  188. C
  189.       MELEME = ISOMM
  190.       NSOMM = MELEME.NUM(/2)
  191.       SEGDES MELEME
  192. C
  193. C**** Le MPOVAL des SURFACES des FACES
  194. C
  195.       CALL LICHT(ISURF,MPOSUR,TYPE,IGEOM)
  196. C
  197. C**** Le MPOVAL des NORMALES aux FACES
  198. C
  199.       CALL LICHT(INORM,MPONOR,TYPE,IGEOM)
  200. C
  201. C**** Le MPOVAL du CHPOINT
  202. C
  203.       CALL LICHT(ICHPO,MPOCHP,TYPE,IGEOM)
  204.  
  205. C**** Le MPOVAL du CHPOINT DU TENSEURS DE DIFFUSIONS
  206. C
  207.       IF (ICHTE.GT.0) THEN
  208.       CALL LICHT(ICHTE,MPOTEN,TYPE,IGEOM)
  209.       ENDIF
  210. C
  211. C**** En LICHT
  212. C     SEGACT*MOD MPOCHP
  213. C
  214.         NCOMP = MPOCHP.VPOCHA(/2)
  215.         IF (ICHTE.GT.0) THEN
  216. c        CALL ECCHPO(ICHTE)
  217.         ENDIF
  218.  
  219. C
  220. C**** Conditions limites (DIRICHLET)
  221. C
  222.       IF (ICHCL .GT. 0) THEN
  223.          TYPE=' '
  224.          CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM)
  225. C
  226. C******* En LICHT
  227. C        SEGACT*MOD MPOVCL
  228. C
  229.          CALL KRIPAD(IGEOM,MLENCL)
  230. C
  231. C******* En KRIPAD
  232. C        SEGACT IGEOM, MLENCL
  233. C
  234.          MELEME = IGEOM
  235.          SEGDES MELEME
  236.       ELSE
  237.          JG = NTOT
  238.          SEGINI MLENCL
  239.          DO I1 = 1 , JG, 1
  240.             MLENCL.LECT(I1)=0
  241.          ENDDO
  242.          MPOVCL = -1
  243.       ENDIF
  244.  
  245. c CONDITIONS DE FLUX
  246.       IF (ICHNE .GT. 0) THEN
  247.          TYPE=' '
  248.          CALL LICHT(ICHNE,MPOVNE,TYPE,IGEOM)
  249. C
  250. C******* En LICHT
  251. C        SEGACT*MOD MPOVNE
  252. C
  253.          CALL KRIPAD(IGEOM,MLENNE)
  254. C
  255. C******* En KRIPAD
  256. C        SEGACT IGEOM, MLENCL
  257. C
  258.          MELEME = IGEOM
  259.          SEGDES MELEME
  260.       ELSE
  261.          JG = NTOT
  262.          SEGINI MLENNE
  263.          DO I1 = 1 , JG, 1
  264.             MLENNE.LECT(I1)=0
  265.          ENDDO
  266.          MPOVNE = -1
  267.       ENDIF
  268.  
  269. c CONDITIONS MIXTES
  270.       IF (ICHMI .GT. 0) THEN
  271.          TYPE=' '
  272.          CALL LICHT(ICHMI,MPOVMI,TYPE,IGEOM)
  273. C
  274. C******* En LICHT
  275. C        SEGACT*MOD MPOVNE
  276. C
  277.          CALL KRIPAD(IGEOM,MLENMI)
  278. C
  279. C******* En KRIPAD
  280. C        SEGACT IGEOM, MLENCL
  281. C
  282.          MELEME = IGEOM
  283.          SEGDES MELEME
  284.       ELSE
  285.          JG = NTOT
  286.          SEGINI MLENMI
  287.          DO I1 = 1 , JG, 1
  288.             MLENMI.LECT(I1)=0
  289.          ENDDO
  290.          MPOVMI = -1
  291.       ENDIF
  292. C
  293. c OPTION FLUX CONVECTIFS
  294.       IF (ICHCO .GT. 0) THEN
  295.          TYPE=' '
  296.          CALL LICHT(ICHCO,MPOVCO,TYPE,IGEOM)
  297. C
  298. C******* En LICHT
  299. C        SEGACT*MOD MPOVNE
  300. C
  301.          CALL KRIPAD(IGEOM,MLENCO)
  302. C
  303. C******* En KRIPAD
  304. C        SEGACT IGEOM, MLENCL
  305. C
  306.          MELEME = IGEOM
  307.          SEGDES MELEME
  308.       ELSE
  309.          JG = NTOT
  310.          SEGINI MLENCO
  311.          DO I1 = 1 , JG, 1
  312.             MLENCO.LECT(I1)=0
  313.          ENDDO
  314.          MPOVCO = -1
  315.       ENDIF
  316. C
  317. C
  318. C**** Boucle sur le FACEL
  319. C
  320.       MELEFL=IFACEL
  321.       MELEFP=IFACEP
  322.       MELEFA=IFAC
  323.       MELTFA = IELTFA
  324.       SEGACT MELEFL
  325.       SEGACT MELEFP
  326.       SEGACT MELEFA
  327.       SEGACT MELTFA
  328. C     FACEL = MAILLAGE NON PARTITIONE
  329.       NFAC=MELEFL.NUM(/2)
  330.  
  331.       IF (IDIM.EQ.2) THEN
  332. c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES
  333.       NAT=1
  334.       NSOUPO=1
  335.       SEGINI MCHPOI
  336.       ICHGRA=MCHPOI
  337.       MCHPOI.MOCHDE=
  338.      &'Gradient VF                                                     '
  339.       MCHPOI.JATTRI=2
  340.       MCHPOI.IFOPOI=IFOUR
  341.       NC=1
  342.       SEGINI MSOUPO
  343.       MCHPOI.IPCHP(1)=MSOUPO
  344.       SEGDES MCHPOI
  345.       DO I1=1,NC,1
  346.          MSOUPO.NOCOMP(I1)='FLUX'
  347.       ENDDO
  348. C
  349. C******* Gradient aux faces
  350.  
  351.          N=NFAC
  352.          NC=1
  353. C
  354. C
  355. C**** Division par les volumes
  356. C
  357.  
  358. C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE
  359. C ON EST ICI
  360.        IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN
  361.  
  362.  
  363. C PARAMETRES POUR LE GRADIENT AUX FACES
  364.          SEGINI MPOGRA
  365.          MSOUPO.IGEOC=IFAC
  366.          MSOUPO.IPOVAL=MPOGRA
  367.          SEGDES MSOUPO
  368.  
  369. c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD
  370.        CALL VFSYM2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  371.      &            MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,MLENNE,
  372.      &            MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,
  373.      &            IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND,
  374.      &            NBFAC,NSOMM,NBMAX)
  375.  
  376. c INVERSION DE CHAQUE MATRICE LOCALE
  377.        CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI,
  378.      &           VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB)
  379.  
  380. c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES
  381. c GRADIENTS
  382.  
  383.        CALL VFSYM4(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  384.      &            MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,
  385.      &            MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP,
  386.      &            IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND,
  387.      &            IPO3,VAUX,TAB,MELEME,MPOGRA,MELVA1,MELVA2,
  388.      &            NBNN,NBFAC,MCHELM,MCHAML)
  389.          ICOEFF = MCHELM
  390.  
  391.          ELSE
  392. C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT
  393.          SEGINI MPOGRA
  394.          MSOUPO.IGEOC=IFAC
  395.          MSOUPO.IPOVAL=MPOGRA
  396.          SEGDES MSOUPO
  397.  
  398.          CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,
  399.      &              MLEFA,MPOCHP,
  400.      &              MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,MPOVMI,
  401.      &              LOGBOR,LOGCCL,LOGCOE)
  402.          ENDIF
  403.          SEGDES MPOGRA
  404.  
  405.  
  406.  
  407. C CAS 3 DIMENSIONS
  408.       ELSE
  409.  
  410. c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES
  411.       NAT=1
  412.       NSOUPO=1
  413.       SEGINI MCHPOI
  414.       ICHGRA=MCHPOI
  415.       MCHPOI.MOCHDE=
  416.      &'Gradient VF                                                     '
  417.       MCHPOI.JATTRI=2
  418.       MCHPOI.IFOPOI=IFOUR
  419.       NC=1
  420.       SEGINI MSOUPO
  421.       MCHPOI.IPCHP(1)=MSOUPO
  422.       SEGDES MCHPOI
  423.       DO I1=1,NC,1
  424.          MSOUPO.NOCOMP(I1)='FLUX'
  425.       ENDDO
  426. C
  427. C******* Gradient aux faces
  428.  
  429.          N=NFAC
  430.          NC=1
  431. C
  432. C
  433. C**** Division par les volumes
  434. C
  435.  
  436. C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE
  437.        IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN
  438.  
  439.  
  440. C PARAMETRES POUR LE GRADIENT AUX FACES
  441.          SEGINI MPOGRA
  442.          MSOUPO.IGEOC=IFAC
  443.          MSOUPO.IPOVAL=MPOGRA
  444.          SEGDES MSOUPO
  445.  
  446. c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD
  447.        CALL SYM2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  448.      &            MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  449.      &            MLENNE,
  450.      &            MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,
  451.      &            IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND,
  452.      &            NBFAC,NBCOT,NSOMM,NBMAX)
  453.  
  454. c INVERSION DE CHAQUE MATRICE LOCALE
  455.        CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI,
  456.      &           VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB)
  457.  
  458. c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES
  459. c GRADIENTS
  460.        CALL SYM4D3(
  461.      &            MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  462.      &            MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  463.      &            MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP,
  464.      &            IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND,
  465.      &            IPO3,TAB,MPOGRA,MELVA1,MELVA2,
  466.      &            NSOMM,NBMAX,NBFAC,NBCOT,MCHELM,MCHAML)
  467.          ICOEFF = MCHELM
  468.  
  469.          ELSE
  470.  
  471. C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT
  472.          SEGINI MPOGRA
  473.          MSOUPO.IGEOC=IFAC
  474.          MSOUPO.IPOVAL=MPOGRA
  475.          SEGDES MSOUPO
  476.          CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,MLEFA,
  477.      &              MPOCHP,MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,
  478.      &              MPOVMI,LOGBOR,LOGCCL,LOGCOE)
  479.  
  480.         ENDIF
  481.          SEGDES MPOGRA
  482.       ENDIF
  483.  
  484.  
  485.  
  486.  
  487.       SEGSUP MLECEN
  488.       SEGDES MPOSUR
  489.       SEGDES MPONOR
  490.       SEGDES MPOCHP
  491.       IF(MPOVCL .GT. 0)THEN
  492.          SEGDES MPOVCL
  493.       ENDIF
  494.       IF(MPOVNE .GT. 0)THEN
  495.          SEGDES MPOVNE
  496.       ENDIF
  497.       IF(MPOVMI .GT. 0)THEN
  498.          SEGDES MPOVMI
  499.       ENDIF
  500.       IF(MPOVCO .GT. 0)THEN
  501.          SEGDES MPOVCO
  502.       ENDIF
  503.       SEGSUP MLENCL
  504.       SEGSUP MLENNE
  505.       SEGSUP MLENMI
  506.       SEGSUP MLENCO
  507.       SEGSUP MLESOM
  508.       SEGSUP NBFAC
  509.       SEGDES MELEFL
  510.       SEGDES MELEFP
  511.       SEGDES MELEFA
  512.       SEGDES MELTFA
  513.  
  514. C
  515.  9999 CONTINUE
  516.       RETURN
  517.       END
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  

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