Télécharger la plaquette Cast3M


fr en

Télécharger varin2.eso

Retour à la liste

Numérotation des lignes : 

varin2

  1. C VARIN2    SOURCE    CB215821  20/11/04    21:21:55     10766          
  2.       SUBROUTINE VARIN2(ICHAM2,MELVA1,COQ,MELEME,SWORK,NOMCO,MELE,
  3.      &                  MELGEO,MINTE,MINTE1,MELVAL,KERRE)
  4. *____________________________________________________________________
  5. *
  6. *  OBJET :  Variation d'un champ/élément ayant une ou des composante(s)
  7. *  °°°°°°°   de type EVOLUTION en fonction d'un champ/point ou
  8. *            d'un champ/élément.Ce champ peut avoir plusieurs composantes
  9. *            si necessaire. Dans ce cas il est possible d'instancier
  10. *            un champ/element dont les composantes dependent de
  11. *            parametres differents en chaque point.
  12. *           Routine appelee par varinu.eso
  13. *
  14. *
  15. *  SORTIE :
  16. *  °°°°°°°°
  17. *
  18. *     MELVAL  Pointeur sur le MCHAML resultat
  19. *     KERRE   Diagnostic d'erreur
  20. *
  21. *_____________________________________________________________________
  22. *
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25. *
  26. -INC SMCHAML
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMEVOLL
  31. -INC SMLREEL
  32. -INC SMELEME
  33. -INC SMINTE
  34. -INC SMCOORD
  35. C
  36.       CHARACTER*(LOCOMP) NOM2,NOMTT,NOM4,NOM3,NOMCO
  37.       LOGICAL COQ
  38. C
  39. C  Creation des segments
  40.       SEGMENT SWORK
  41.          REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBNN)
  42.          REAL*8 SHP(6,NBNN) ,XE(3,NBNN)
  43.       ENDSEGMENT
  44.       SEGMENT IAMOI
  45.          REAL*8 VEL1(MG1,N1EL2),VEL2(MG2,MXNBE)
  46.       ENDSEGMENT
  47. C
  48.       DATA NOMTT/'T       '/
  49. C
  50.       KERRE =0
  51.       ICHAN =0
  52.       IPOIN1=0
  53. C
  54.       MCHAM2=ICHAM2
  55.       NBNN  =NUM(/1)
  56.       NEL0  =NUM(/2)
  57.       NBPGAU=SHPTOT(/3)
  58.       N1PTE3=MELVA1.IELCHE(/1)
  59.       N1EL3 =MELVA1.IELCHE(/2)
  60.       NCO1  = MCHAM2.IELVAL(/1)
  61.       IEVOL = MELVA1.IELCHE(1,1)
  62.       MEVOLL= IEVOL
  63.       KEVOLL= IEVOLL(1)
  64.       NOM3  = NOMEVY
  65.       NOM4  = NOMEVX
  66. C
  67. C  Cas des coques dont les caracteristiques dependent de T
  68. C
  69.       IF (COQ.AND.NOM4.EQ.NOMTT) THEN
  70.         INO2 = 0
  71.         INO1 = 0
  72.         INO3 = 0
  73.         DO 10 INO = 1,NCO1
  74.           NOM2 = MCHAM2.NOMCHE(INO)
  75.           IF (NOM2.EQ.NOMTT     ) INO2=INO
  76.           IF (NOM2.EQ.'TINF    ') INO1=INO
  77.           IF (NOM2.EQ.'TSUP    ') INO3=INO
  78.   10    CONTINUE
  79.         IF (INO1.NE.0.AND.INO2.NE.0.AND.INO3.NE.0) THEN
  80. C
  81.           MELVA3=MCHAM2.IELVAL(INO1)
  82.           MELVA4=MCHAM2.IELVAL(INO3)
  83. C
  84.           NBP2=MELVA4.VELCHE(/1)
  85.           NBP1=MELVA3.VELCHE(/1)
  86.           NEL1=MELVA3.VELCHE(/2)
  87.           NEL2=MELVA4.VELCHE(/2)
  88.           N1PTEL=MAX(NBP1,NBP2)
  89.           N1EL  =MAX(NEL1,NEL2)
  90.           N2PTEL=0
  91.           N2EL  =0
  92.           SEGINI MELVA5
  93.           DO 20 IGAU=1,N1PTEL
  94.             IGMN1=MIN(IGAU,MELVA3.VELCHE(/1))
  95.             IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))
  96.             DO 30 IB=1,N1EL
  97.               IBMN1=MIN(IB,MELVA3.VELCHE(/2))
  98.               IBMN2=MIN(IB,MELVA4.VELCHE(/2))
  99.               MELVA5.VELCHE(IGAU,IB)=MELVA3.VELCHE(IGMN1,IBMN1)+
  100.      &                               MELVA4.VELCHE(IGMN2,IBMN2)
  101.   30        CONTINUE
  102.   20      CONTINUE
  103. C
  104.           MELVA3=MCHAM2.IELVAL(INO2)
  105. C
  106.           N1PTEL = MELVA3.VELCHE(/1)
  107.           N1EL = MELVA3.VELCHE(/2)
  108.           N2PTEL = 0
  109.           N2EL = 0
  110.           SEGINI MELVA4
  111.           DO 40 II = 1,N1PTEL
  112.             DO 50 III = 1,N1EL
  113.               MELVA4.VELCHE(II,III) = 4.D0*MELVA3.VELCHE(II,III)
  114.   50        CONTINUE
  115.   40      CONTINUE
  116. C
  117.           NBP2=MELVA4.VELCHE(/1)
  118.           NBP1=MELVA5.VELCHE(/1)
  119.           NEL1=MELVA5.VELCHE(/2)
  120.           NEL2=MELVA4.VELCHE(/2)
  121.           N1PTEL=MAX(NBP1,NBP2)
  122.           N1EL  =MAX(NEL1,NEL2)
  123.           N2PTEL=0
  124.           N2EL  =0
  125.           SEGINI MELVA6
  126.           DO 60 IGAU=1,N1PTEL
  127.             IGMN1=MIN(IGAU,MELVA5.VELCHE(/1))
  128.             IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))
  129.             DO 70 IB=1,N1EL
  130.               IBMN1=MIN(IB,MELVA5.VELCHE(/2))
  131.               IBMN2=MIN(IB,MELVA4.VELCHE(/2))
  132.               MELVA6.VELCHE(IGAU,IB)=MELVA5.VELCHE(IGMN1,IBMN1)+
  133.      &                               MELVA4.VELCHE(IGMN2,IBMN2)
  134.   70        CONTINUE
  135.   60      CONTINUE
  136.           SEGSUP MELVA4,MELVA5
  137. C
  138.           N1PTEL = MELVA6.VELCHE(/1)
  139.           N1EL = MELVA6.VELCHE(/2)
  140.           N2PTEL = 0
  141.           N2EL = 0
  142.           SEGINI MELVA2
  143.           DO 80 II = 1,N1PTEL
  144.             DO 90 III = 1,N1EL
  145.               MELVA2.VELCHE(II,III) = 1.D0/6.D0*MELVA6.VELCHE(II,III)
  146.   90        CONTINUE
  147.   80      CONTINUE
  148.           SEGSUP MELVA6
  149. C
  150.           GOTO 100
  151.         ELSEIF (INO2.NE.0) THEN
  152.           MELVA2=MCHAM2.IELVAL(INO2)
  153.           GOTO 100
  154.         ENDIF
  155.       ELSE
  156.         DO 110 INO = 1,NCO1
  157.           NOM2 = MCHAM2.NOMCHE(INO)
  158.           IF (NOM3.EQ.NOMCO.or.(nomco.eq.'MOCO'.and.NOM3.eq.'RAID').or.
  159.      &(nomco.eq.'MOCO'.and.NOM3.eq.'VISC'))
  160.      & THEN
  161.             IF (NOM4.EQ.NOM2.OR.(NOM2.EQ.'TEMP'.AND.NOM4.EQ.'FREQ'))
  162.      & THEN
  163.               MELVA2=MCHAM2.IELVAL(INO)
  164.               GOTO 100
  165.             ENDIF
  166.           ENDIF
  167.  110    CONTINUE
  168.       ENDIF
  169. C
  170.       KERRE=665
  171.       RETURN
  172. C
  173.  100  CONTINUE
  174. C
  175. C  On teste la taille de MCHAML_FLOTTANT
  176.       N1PTE2=MELVA2.VELCHE(/1)
  177.       N1EL2 =MELVA2.VELCHE(/2)
  178.       IF (N1EL2.NE.NEL0.AND.N1EL2.NE.1.AND.NEL0.NE.1) THEN
  179.         KERRE=146
  180.         RETURN
  181.       ENDIF
  182.       IF (N1PTE2.NE.1.AND.N1PTE2.NE.NBPGAU) THEN
  183.         KERRE=146
  184.         RETURN
  185.       ENDIF
  186. C  On teste la taille entre MCHAML_EVOLUTION et MCHAML_FLOTTANT
  187.       IF (N1EL2.NE.N1EL3.AND.N1EL2.NE.1.AND.N1EL3.NE.1) THEN
  188.         KERRE=146
  189.         RETURN
  190.       ENDIF
  191. C  Si MCHAML_FLOTTANT ou la loi de variation n'est pas constant
  192. C  et de plus leur support geometrique est different, alors on
  193. C  change le support de MCHAML_FLOTTANT (MINTE) vers le support
  194. C  de MCHAML_EVOLUTION (MINTE1). Quand l'interpolation est finie,
  195. C  on change le support geometrique de MCHAML_FLOTTANT resultat
  196. C  vers le support demandé (MINTE).
  197. C  Tableau VEL1 contient les valeurs au support MINTE1
  198. C  Tableau VEL2 contient les valeurs interpolées selon
  199. C  la loi de variation et appuyées au support MINTE1
  200.       MXNBE=MAX(N1EL2,N1EL3)
  201.       IF (N1PTE3.NE.1.AND.MINTE.NE.MINTE1) THEN
  202.         ICHAN=1
  203.         IF (N1PTE2.EQ.1) THEN
  204.           MG1=1
  205.         ELSE
  206.           MG1=N1PTE3
  207.         ENDIF
  208.         MG2=N1PTE3
  209.         SEGINI IAMOI
  210.         CALL ZERO(VEL1,MG1,N1EL2)
  211.         CALL ZERO(VEL2,MG2,MXNBE)
  212. C  Pour les COQ4, le nb de pt de GAUSS vaux 5, mais
  213. C  on ne prend que les 4 premiers
  214.         N1PAUX=N1PTE2
  215.         IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  216.         DO 120 IEL=1,N1EL2
  217.           IF (N1PTE2.EQ.1) THEN
  218.             VEL1(1,IEL)=MELVA2.VELCHE(1,IEL)
  219.           ELSE
  220.             DO 130 IGAU=1,N1PTE2
  221.               VAL1(IGAU)=MELVA2.VELCHE(IGAU,IEL)
  222.  130        CONTINUE
  223.             IF (MINTE1.NE.0) THEN
  224.               CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  225.               CALL QUEDIM(MELGEO,KERRE)
  226.               CALL CH1CH2(MELE,MINTE1,MINTE,N1PTE3,N1PAUX,NBNN,SWORK,
  227.      &                    IPOIN1,KERRE)
  228.               IF (KERRE.NE.0) THEN
  229.                 SEGSUP IAMOI
  230.                 RETURN
  231.               ENDIF
  232.               DO 140 IGAU=1,N1PTE3
  233.                 VEL1(IGAU,IEL)=VAL2(IGAU)
  234.  140          CONTINUE
  235.             ELSE
  236.               DO 150 IGAU=1,N1PTE3
  237.                 VALG=0.D0
  238.                 DO 160 INO=1,NBNN
  239.                   VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  240.  160            CONTINUE
  241.                 VEL1(IGAU,IEL)=VALG
  242.  150          CONTINUE
  243.             ENDIF
  244.           ENDIF
  245.  120    CONTINUE
  246.       ELSE
  247.         MG2=NBPGAU
  248.         IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) MG2=1
  249.       ENDIF
  250. C  Recherche de la taille du nouveau chamelem
  251.       N2PTEL=0
  252.       N2EL  =0
  253.       N1PTEL=NBPGAU
  254.       N1EL  =MXNBE
  255.       IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) N1PTEL=1
  256.       SEGINI MELVAL
  257. C  Boucle sur les points de gauss et les éléments
  258.       DO 170 IEL=1,MXNBE
  259.         DO 180 IGAU=1,MG2
  260.           IG=IGAU
  261.           IF (N1PTE3.EQ.1) IG=1
  262.           IE=IEL
  263.           IF (N1EL3.EQ.1) IE=1
  264. C  On active l'objet EVOLUTION
  265.           IEVOL =MELVA1.IELCHE(IG,IE)
  266.           MEVOLL=IEVOL
  267.           KEVOLL=IEVOLL(1)
  268.           MLREEL=IPROGX
  269.           MLREE1=IPROGY
  270.  
  271.           INEW=0
  272.           LON =PROG(/1)
  273. C
  274. C test pour renverser les suites si ls premiere est decroissante
  275. C
  276.           IF (PROG(LON) .LT. PROG(1)) THEN
  277.             JG=LON
  278.             JFIN=LON+1
  279.             SEGINI MLREE2,MLREE3
  280.             INEW=1
  281.             DO 190 IO=1,LON
  282.               MLREE2.PROG(IO)=PROG(JFIN-IO)
  283.               MLREE3.PROG(IO)=MLREE1.PROG(JFIN-IO)
  284.  190        CONTINUE
  285.             MLREEL=MLREE2
  286.             MLREE1=MLREE3
  287.           ENDIF
  288.  
  289. C
  290. C  Interpolation linéaire
  291. C  CB215821 : Cas de LISTREEL de 1 seule valeur => resultat connu !
  292.           IF(PROG(/1) .EQ. 1) THEN
  293.             VAINT = MLREE1.PROG(1)
  294.  
  295.           ELSE
  296. C           On cherche la valeur à interpoler
  297.             IG=IGAU
  298.             IE=IEL
  299.             IF (ICHAN.EQ.1) THEN
  300.               IF (VEL1(/1).EQ.1) IG=1
  301.               IF (VEL1(/2).EQ.1) IE=1
  302.               VA1=VEL1(IG,IE)
  303.  
  304.             ELSE
  305.               IF (N1PTE2.EQ.1) IG=1
  306.               IF (N1EL2 .EQ.1) IE=1
  307.               VA1=MELVA2.VELCHE(IG,IE)
  308.             ENDIF
  309.  
  310.             DO 200 IP=2,PROG(/1)
  311.               I1=IP
  312.               IF (PROG(IP).GT.VA1) GOTO 210
  313.  200        CONTINUE
  314.  210        CONTINUE
  315.             I2=I1-1
  316.             IF(PROG(I1)-PROG(I2).EQ.0.) THEN
  317.                KERRE = 835
  318.                IF (INEW.EQ.1) THEN
  319.                  SEGSUP MLREEL,MLREE1
  320.                ENDIF
  321.                RETURN
  322.             ENDIF
  323.             PENTE=(MLREE1.PROG(I1)-MLREE1.PROG(I2))/
  324.      &                  (PROG(I1)-PROG(I2))
  325.             VAINT=MLREE1.PROG(I2)+PENTE*(VA1-PROG(I2))
  326. *           kich : valeur hors segment Valeur egale a la borne depassee
  327.             if (va1.lt.prog(1)) vaint=MLREE1.PROG(1)
  328.             if (va1.gt.prog(prog(/1))) vaint=MLREE1.PROG(PROG(/1))
  329. *            write(6,fmt='(1X,''IGAU,IEL,VA1,VEL2'',2I6,2E13.5)')
  330. *                               IGAU,IEL,VA1,VAINT
  331.           ENDIF
  332.  
  333.           IF (ICHAN.EQ.1) THEN
  334.             VEL2(IGAU,IEL)=VAINT
  335.           ELSE
  336.             VELCHE(IGAU,IEL)=VAINT
  337.           ENDIF
  338. C
  339.           IF (INEW.EQ.1) THEN
  340.             SEGSUP MLREEL,MLREE1
  341.           ENDIF
  342.  180    CONTINUE
  343.  170  CONTINUE
  344. C  On change les valeurs interpolées au support demandé
  345.       IF (ICHAN.EQ.1) THEN
  346.         N1PAUX=N1PTE3
  347.         IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  348.         DO 220 IEL=1,MXNBE
  349.           DO 230 IGAU=1,N1PTE3
  350.             VAL1(IGAU)=VEL2(IGAU,IEL)
  351.  230      CONTINUE
  352.           IF (MINTE1.NE.0) THEN
  353.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  354.             CALL QUEDIM(MELGEO,KERRE)
  355.             CALL CH1CH2(MELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBNN,SWORK,
  356.      &                    IPOIN1,KERRE)
  357.             IF (KERRE.NE.0) THEN
  358.               SEGSUP IAMOI
  359.               RETURN
  360.             ENDIF
  361.             DO 240 IGAU=1,N1PTEL
  362.               VELCHE(IGAU,IEL)=VAL2(IGAU)
  363.  240        CONTINUE
  364.           ELSE
  365.             DO 250 IGAU=1,N1PTEL
  366.               VALG=0.D0
  367.               DO 260 INO=1,NBNN
  368.                 VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  369.  260          CONTINUE
  370.               VELCHE(IGAU,IEL)=VALG
  371.  250        CONTINUE
  372.           ENDIF
  373.  220    CONTINUE
  374.       ENDIF
  375.  
  376.       END
  377.  
  378.  
  379.  

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