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    MB234859  26/06/04    21:15:36     12564          
  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.                 IF (KERRE.EQ.195) INTERR(1)=IEL
  231.                 CALL ERREUR(KERRE)
  232.                 RETURN
  233.               ENDIF
  234.               DO 140 IGAU=1,N1PTE3
  235.                 VEL1(IGAU,IEL)=VAL2(IGAU)
  236.  140          CONTINUE
  237.             ELSE
  238.               DO 150 IGAU=1,N1PTE3
  239.                 VALG=0.D0
  240.                 DO 160 INO=1,NBNN
  241.                   VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  242.  160            CONTINUE
  243.                 VEL1(IGAU,IEL)=VALG
  244.  150          CONTINUE
  245.             ENDIF
  246.           ENDIF
  247.  120    CONTINUE
  248.       ELSE
  249.         MG2=NBPGAU
  250.         IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) MG2=1
  251.       ENDIF
  252. C  Recherche de la taille du nouveau chamelem
  253.       N2PTEL=0
  254.       N2EL  =0
  255.       N1PTEL=NBPGAU
  256.       N1EL  =MXNBE
  257.       IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) N1PTEL=1
  258.       SEGINI MELVAL
  259. C  Boucle sur les points de gauss et les éléments
  260.       DO 170 IEL=1,MXNBE
  261.         DO 180 IGAU=1,MG2
  262.           IG=IGAU
  263.           IF (N1PTE3.EQ.1) IG=1
  264.           IE=IEL
  265.           IF (N1EL3.EQ.1) IE=1
  266. C  On active l'objet EVOLUTION
  267.           IEVOL =MELVA1.IELCHE(IG,IE)
  268.           MEVOLL=IEVOL
  269.           KEVOLL=IEVOLL(1)
  270.           MLREEL=IPROGX
  271.           MLREE1=IPROGY
  272.  
  273.           INEW=0
  274.           LON =PROG(/1)
  275. C
  276. C test pour renverser les suites si ls premiere est decroissante
  277. C
  278.           IF (PROG(LON) .LT. PROG(1)) THEN
  279.             JG=LON
  280.             JFIN=LON+1
  281.             SEGINI MLREE2,MLREE3
  282.             INEW=1
  283.             DO 190 IO=1,LON
  284.               MLREE2.PROG(IO)=PROG(JFIN-IO)
  285.               MLREE3.PROG(IO)=MLREE1.PROG(JFIN-IO)
  286.  190        CONTINUE
  287.             MLREEL=MLREE2
  288.             MLREE1=MLREE3
  289.           ENDIF
  290.  
  291. C
  292. C  Interpolation linéaire
  293. C  CB215821 : Cas de LISTREEL de 1 seule valeur => resultat connu !
  294.           IF(PROG(/1) .EQ. 1) THEN
  295.             VAINT = MLREE1.PROG(1)
  296.  
  297.           ELSE
  298. C           On cherche la valeur à interpoler
  299.             IG=IGAU
  300.             IE=IEL
  301.             IF (ICHAN.EQ.1) THEN
  302.               IF (VEL1(/1).EQ.1) IG=1
  303.               IF (VEL1(/2).EQ.1) IE=1
  304.               VA1=VEL1(IG,IE)
  305.  
  306.             ELSE
  307.               IF (N1PTE2.EQ.1) IG=1
  308.               IF (N1EL2 .EQ.1) IE=1
  309.               VA1=MELVA2.VELCHE(IG,IE)
  310.             ENDIF
  311.  
  312.             DO 200 IP=2,PROG(/1)
  313.               I1=IP
  314.               IF (PROG(IP).GT.VA1) GOTO 210
  315.  200        CONTINUE
  316.  210        CONTINUE
  317.             I2=I1-1
  318.             IF(PROG(I1)-PROG(I2).EQ.0.) THEN
  319.                KERRE = 835
  320.                IF (INEW.EQ.1) THEN
  321.                  SEGSUP MLREEL,MLREE1
  322.                ENDIF
  323.                RETURN
  324.             ENDIF
  325.             PENTE=(MLREE1.PROG(I1)-MLREE1.PROG(I2))/
  326.      &                  (PROG(I1)-PROG(I2))
  327.             VAINT=MLREE1.PROG(I2)+PENTE*(VA1-PROG(I2))
  328. *           kich : valeur hors segment Valeur egale a la borne depassee
  329.             if (va1.lt.prog(1)) vaint=MLREE1.PROG(1)
  330.             if (va1.gt.prog(prog(/1))) vaint=MLREE1.PROG(PROG(/1))
  331. *            write(6,fmt='(1X,''IGAU,IEL,VA1,VEL2'',2I6,2E13.5)')
  332. *                               IGAU,IEL,VA1,VAINT
  333.           ENDIF
  334.  
  335.           IF (ICHAN.EQ.1) THEN
  336.             VEL2(IGAU,IEL)=VAINT
  337.           ELSE
  338.             VELCHE(IGAU,IEL)=VAINT
  339.           ENDIF
  340. C
  341.           IF (INEW.EQ.1) THEN
  342.             SEGSUP MLREEL,MLREE1
  343.           ENDIF
  344.  180    CONTINUE
  345.  170  CONTINUE
  346. C  On change les valeurs interpolées au support demandé
  347.       IF (ICHAN.EQ.1) THEN
  348.         N1PAUX=N1PTE3
  349.         IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  350.         DO 220 IEL=1,MXNBE
  351.           DO 230 IGAU=1,N1PTE3
  352.             VAL1(IGAU)=VEL2(IGAU,IEL)
  353.  230      CONTINUE
  354.           IF (MINTE1.NE.0) THEN
  355.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  356.             CALL QUEDIM(MELGEO,KERRE)
  357.             CALL CH1CH2(MELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBNN,SWORK,
  358.      &                    IPOIN1,KERRE)
  359.             IF (KERRE.NE.0) THEN
  360.               SEGSUP IAMOI
  361.               RETURN
  362.             ENDIF
  363.             DO 240 IGAU=1,N1PTEL
  364.               VELCHE(IGAU,IEL)=VAL2(IGAU)
  365.  240        CONTINUE
  366.           ELSE
  367.             DO 250 IGAU=1,N1PTEL
  368.               VALG=0.D0
  369.               DO 260 INO=1,NBNN
  370.                 VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  371.  260          CONTINUE
  372.               VELCHE(IGAU,IEL)=VALG
  373.  250        CONTINUE
  374.           ENDIF
  375.  220    CONTINUE
  376.       ENDIF
  377.  
  378.       END
  379.  
  380.  
  381.  
  382.  
  383.  

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