Télécharger la plaquette Cast3M


fr en

Télécharger norv1.eso

Retour à la liste

Numérotation des lignes : 

norv1

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

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