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    JK148537  26/08/05    21:15:08     12617          
  2.       SUBROUTINE VARIN2(ICHAM2,MELVA1,COQ,MELEME,SWORK,NOMCO,MELE,
  3.      &       MELGEO,MINTE,MINTE1,MELVAL,KERRE,ipfusi,iptmax,lotmax)
  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.       POINTEUR metmax.melval,metfus.melval
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMEVOLL
  32. -INC SMLREEL
  33. -INC SMELEME
  34. -INC SMINTE
  35. -INC SMCOORD
  36. C
  37.       CHARACTER*(LOCOMP) NOM2,NOMTT,NOM4,NOM3,NOMCO
  38.       LOGICAL COQ,lotmax,l2tmax
  39. C
  40. C  Creation des segments
  41.       SEGMENT SWORK
  42.          REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBNN)
  43.          REAL*8 SHP(6,NBNN) ,XE(3,NBNN)
  44.       ENDSEGMENT
  45.       SEGMENT IAMOI
  46.          REAL*8 VEL1(MG1,N1EL2),VEL2(MG2,MXNBE)
  47.       ENDSEGMENT
  48. C
  49.       DATA NOMTT/'T       '/
  50. C
  51.       KERRE =0
  52.       ICHAN =0
  53.       IPOIN1=0
  54. C
  55.       l2tmax = .false.
  56.       if (iptmax.gt.0) then
  57.         if (ipfusi.gt.0) then
  58.           l2tmax = .true.
  59.           metmax = iptmax
  60.           n2ptma = metmax.velche(/1)
  61.           n2elma = metmax.velche(/2)
  62.           metfus = ipfusi
  63.           n2ptfu = metfus.velche(/1)
  64.           n2elfu = metfus.velche(/2)
  65.         endif
  66.       endif
  67. C
  68.       MCHAM2=ICHAM2
  69.       NBNN  =NUM(/1)
  70.       NEL0  =NUM(/2)
  71.       NBPGAU=SHPTOT(/3)
  72.       NCO1  = MCHAM2.IELVAL(/1)
  73.       if (lotmax) then
  74.         N1PTE3=MELVA1.VELCHE(/1)
  75.         N1EL3 =MELVA1.VELCHE(/2)
  76.       else
  77.       N1PTE3=MELVA1.IELCHE(/1)
  78.       N1EL3 =MELVA1.IELCHE(/2)
  79.       IEVOL = MELVA1.IELCHE(1,1)
  80.       MEVOLL= IEVOL
  81.       KEVOLL= IEVOLL(1)
  82.       NOM3  = NOMEVY
  83.       NOM4  = NOMEVX
  84.       endif
  85. C
  86. C  Cas des coques dont les caracteristiques dependent de T
  87. C
  88.       IF (COQ.AND.NOM4.EQ.NOMTT) THEN
  89.         INO2 = 0
  90.         INO1 = 0
  91.         INO3 = 0
  92.         DO 10 INO = 1,NCO1
  93.           NOM2 = MCHAM2.NOMCHE(INO)
  94.           IF (NOM2.EQ.NOMTT     ) INO2=INO
  95.           IF (NOM2.EQ.'TINF    ') INO1=INO
  96.           IF (NOM2.EQ.'TSUP    ') INO3=INO
  97.   10    CONTINUE
  98.         IF (INO1.NE.0.AND.INO2.NE.0.AND.INO3.NE.0) THEN
  99. C
  100.           MELVA3=MCHAM2.IELVAL(INO1)
  101.           MELVA4=MCHAM2.IELVAL(INO3)
  102. C
  103.           NBP2=MELVA4.VELCHE(/1)
  104.           NBP1=MELVA3.VELCHE(/1)
  105.           NEL1=MELVA3.VELCHE(/2)
  106.           NEL2=MELVA4.VELCHE(/2)
  107.           N1PTEL=MAX(NBP1,NBP2)
  108.           N1EL  =MAX(NEL1,NEL2)
  109.           N2PTEL=0
  110.           N2EL  =0
  111.           SEGINI MELVA5
  112.           DO 20 IGAU=1,N1PTEL
  113.             IGMN1=MIN(IGAU,MELVA3.VELCHE(/1))
  114.             IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))
  115.             DO 30 IB=1,N1EL
  116.               IBMN1=MIN(IB,MELVA3.VELCHE(/2))
  117.               IBMN2=MIN(IB,MELVA4.VELCHE(/2))
  118.               MELVA5.VELCHE(IGAU,IB)=MELVA3.VELCHE(IGMN1,IBMN1)+
  119.      &                               MELVA4.VELCHE(IGMN2,IBMN2)
  120.   30        CONTINUE
  121.   20      CONTINUE
  122. C
  123.           MELVA3=MCHAM2.IELVAL(INO2)
  124. C
  125.           N1PTEL = MELVA3.VELCHE(/1)
  126.           N1EL = MELVA3.VELCHE(/2)
  127.           N2PTEL = 0
  128.           N2EL = 0
  129.           SEGINI MELVA4
  130.           DO 40 II = 1,N1PTEL
  131.             DO 50 III = 1,N1EL
  132.               MELVA4.VELCHE(II,III) = 4.D0*MELVA3.VELCHE(II,III)
  133.   50        CONTINUE
  134.   40      CONTINUE
  135. C
  136.           NBP2=MELVA4.VELCHE(/1)
  137.           NBP1=MELVA5.VELCHE(/1)
  138.           NEL1=MELVA5.VELCHE(/2)
  139.           NEL2=MELVA4.VELCHE(/2)
  140.           N1PTEL=MAX(NBP1,NBP2)
  141.           N1EL  =MAX(NEL1,NEL2)
  142.           N2PTEL=0
  143.           N2EL  =0
  144.           SEGINI MELVA6
  145.           DO 60 IGAU=1,N1PTEL
  146.             IGMN1=MIN(IGAU,MELVA5.VELCHE(/1))
  147.             IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))
  148.             DO 70 IB=1,N1EL
  149.               IBMN1=MIN(IB,MELVA5.VELCHE(/2))
  150.               IBMN2=MIN(IB,MELVA4.VELCHE(/2))
  151.               MELVA6.VELCHE(IGAU,IB)=MELVA5.VELCHE(IGMN1,IBMN1)+
  152.      &                               MELVA4.VELCHE(IGMN2,IBMN2)
  153.   70        CONTINUE
  154.   60      CONTINUE
  155.           SEGSUP MELVA4,MELVA5
  156. C
  157.           N1PTEL = MELVA6.VELCHE(/1)
  158.           N1EL = MELVA6.VELCHE(/2)
  159.           N2PTEL = 0
  160.           N2EL = 0
  161.           SEGINI MELVA2
  162.           DO 80 II = 1,N1PTEL
  163.             DO 90 III = 1,N1EL
  164.               MELVA2.VELCHE(II,III) = 1.D0/6.D0*MELVA6.VELCHE(II,III)
  165.   90        CONTINUE
  166.   80      CONTINUE
  167.           SEGSUP MELVA6
  168. C
  169.           GOTO 100
  170.         ELSEIF (INO2.NE.0) THEN
  171.           MELVA2=MCHAM2.IELVAL(INO2)
  172.           GOTO 100
  173.         ENDIF
  174.       ELSE
  175.         DO 110 INO = 1,NCO1
  176.           NOM2 = MCHAM2.NOMCHE(INO)
  177.           if (lotmax.and.nom2.eq.NOMTT) then
  178.             MELVA2=MCHAM2.IELVAL(INO)
  179.             goto 100
  180.           endif
  181.           IF (NOM3.EQ.NOMCO.or.(nomco.eq.'MOCO'.and.NOM3.eq.'RAID').or.
  182.      &(nomco.eq.'MOCO'.and.NOM3.eq.'VISC'))
  183.      & THEN
  184.             IF (NOM4.EQ.NOM2.OR.(NOM2.EQ.'TEMP'.AND.NOM4.EQ.'FREQ'))
  185.      & THEN
  186.               MELVA2=MCHAM2.IELVAL(INO)
  187.               GOTO 100
  188.             ENDIF
  189.           ENDIF
  190.  110    CONTINUE
  191.       ENDIF
  192. C
  193.       KERRE=665
  194.       RETURN
  195. C
  196.  100  CONTINUE
  197. C
  198. C  On teste la taille de MCHAML_FLOTTANT
  199.       N1PTE2=MELVA2.VELCHE(/1)
  200.       N1EL2 =MELVA2.VELCHE(/2)
  201.       IF (N1EL2.NE.NEL0.AND.N1EL2.NE.1.AND.NEL0.NE.1) THEN
  202.         KERRE=146
  203.         RETURN
  204.       ENDIF
  205.       IF (N1PTE2.NE.1.AND.N1PTE2.NE.NBPGAU) THEN
  206.         KERRE=146
  207.         RETURN
  208.       ENDIF
  209. C  On teste la taille entre MCHAML_EVOLUTION et MCHAML_FLOTTANT
  210.       IF (N1EL2.NE.N1EL3.AND.N1EL2.NE.1.AND.N1EL3.NE.1) THEN
  211.         KERRE=146
  212.         RETURN
  213.       ENDIF
  214. C  Si MCHAML_FLOTTANT ou la loi de variation n'est pas constant
  215. C  et de plus leur support geometrique est different, alors on
  216. C  change le support de MCHAML_FLOTTANT (MINTE) vers le support
  217. C  de MCHAML_EVOLUTION (MINTE1). Quand l'interpolation est finie,
  218. C  on change le support geometrique de MCHAML_FLOTTANT resultat
  219. C  vers le support demandé (MINTE).
  220. C  Tableau VEL1 contient les valeurs au support MINTE1
  221. C  Tableau VEL2 contient les valeurs interpolées selon
  222. C  la loi de variation et appuyées au support MINTE1
  223.       MXNBE=MAX(N1EL2,N1EL3)
  224.       IF (N1PTE3.NE.1.AND.MINTE.NE.MINTE1) THEN
  225.         ICHAN=1
  226.         IF (N1PTE2.EQ.1) THEN
  227.           MG1=1
  228.         ELSE
  229.           MG1=N1PTE3
  230.         ENDIF
  231.         MG2=N1PTE3
  232.         SEGINI IAMOI
  233.         CALL ZERO(VEL1,MG1,N1EL2)
  234.         CALL ZERO(VEL2,MG2,MXNBE)
  235. C  Pour les COQ4, le nb de pt de GAUSS vaux 5, mais
  236. C  on ne prend que les 4 premiers
  237.         N1PAUX=N1PTE2
  238.         IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  239.         DO 120 IEL=1,N1EL2
  240.           IF (N1PTE2.EQ.1) THEN
  241.             VEL1(1,IEL)=MELVA2.VELCHE(1,IEL)
  242.           ELSE
  243.             DO 130 IGAU=1,N1PTE2
  244.               VAL1(IGAU)=MELVA2.VELCHE(IGAU,IEL)
  245.  130        CONTINUE
  246.             IF (MINTE1.NE.0) THEN
  247.               CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  248.               CALL QUEDIM(MELGEO,KERRE)
  249.               CALL CH1CH2(MELE,MINTE1,MINTE,N1PTE3,N1PAUX,NBNN,SWORK,
  250.      &                    IPOIN1,KERRE)
  251.               IF (KERRE.NE.0) THEN
  252.                 SEGSUP IAMOI
  253.                 IF (KERRE.EQ.195) INTERR(1)=IEL
  254.                 CALL ERREUR(KERRE)
  255.                 RETURN
  256.               ENDIF
  257.               DO 140 IGAU=1,N1PTE3
  258.                 VEL1(IGAU,IEL)=VAL2(IGAU)
  259.  140          CONTINUE
  260.             ELSE
  261.               DO 150 IGAU=1,N1PTE3
  262.                 VALG=0.D0
  263.                 DO 160 INO=1,NBNN
  264.                   VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  265.  160            CONTINUE
  266.                 VEL1(IGAU,IEL)=VALG
  267.  150          CONTINUE
  268.             ENDIF
  269.           ENDIF
  270.  120    CONTINUE
  271.       ELSE
  272.         MG2=NBPGAU
  273.         IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) MG2=1
  274.       ENDIF
  275. C  Recherche de la taille du nouveau chamelem
  276.       N2PTEL=0
  277.       N2EL  =0
  278.       N1PTEL=NBPGAU
  279.       N1EL  =MXNBE
  280.       IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) N1PTEL=1
  281.       SEGINI MELVAL
  282. C  Boucle sur les points de gauss et les éléments
  283.       DO 170 IEL=1,MXNBE
  284.         DO 180 IGAU=1,MG2
  285.           IG=IGAU
  286.           IF (N1PTE3.EQ.1) IG=1
  287.           IE=IEL
  288.           IF (N1EL3.EQ.1) IE=1
  289.  
  290. C           On cherche la valeur à interpoler
  291.             IG2=IGAU
  292.             IE2=IEL
  293.             IF (ICHAN.EQ.1) THEN
  294.               IF (VEL1(/1).EQ.1) IG2=1
  295.               IF (VEL1(/2).EQ.1) IE2=1
  296.               VA1=VEL1(IG2,IE2)
  297.  
  298.             ELSE
  299.               IF (N1PTE2.EQ.1) IG2=1
  300.               IF (N1EL2 .EQ.1) IE2=1
  301.               VA1=MELVA2.VELCHE(IG2,IE2)
  302.             ENDIF
  303.  
  304.  
  305.  
  306.  
  307.          if (lotmax) then
  308. C TMAX
  309.             IF (VA1.GT.MELVA1.VELCHE(IG,IE)) then
  310.               VAINT = VA1
  311.             ELSE
  312.               VAINT = MELVA1.VELCHE(IG,IE)
  313.             ENDIF
  314.          else
  315. C  On active l'objet EVOLUTION
  316.           IEVOL =MELVA1.IELCHE(IG,IE)
  317.           MEVOLL=IEVOL
  318.           if (ievoll(/1).gt.1) then
  319.            if (l2tmax) then
  320.             igma = min(igau,n2ptma)
  321.             iema = min(iel,n2elma)
  322.             ytmax = metmax.velche(igma,iema)
  323.             igfu = min(igau,n2ptfu)
  324.             iefu = min(iel,n2elfu)
  325.             ytfus = metfus.velche(igfu,iefu)
  326.             if (ytmax.le.ytfus) kevoll = ievoll(1)
  327.             if (ytmax.gt.ytfus) kevoll = ievoll(2)
  328.            else
  329.             KEVOLL=IEVOLL(1)
  330.            endif
  331.           endif
  332.           MLREEL=IPROGX
  333.           MLREE1=IPROGY
  334.  
  335.           INEW=0
  336.           LON =PROG(/1)
  337. C
  338. C test pour renverser les suites si ls premiere est decroissante
  339. C
  340.           IF (PROG(LON) .LT. PROG(1)) THEN
  341.             JG=LON
  342.             JFIN=LON+1
  343.             SEGINI MLREE2,MLREE3
  344.             INEW=1
  345.             DO 190 IO=1,LON
  346.               MLREE2.PROG(IO)=PROG(JFIN-IO)
  347.               MLREE3.PROG(IO)=MLREE1.PROG(JFIN-IO)
  348.  190        CONTINUE
  349.             MLREEL=MLREE2
  350.             MLREE1=MLREE3
  351.           ENDIF
  352.  
  353. C
  354. C  Interpolation linéaire
  355. C  CB215821 : Cas de LISTREEL de 1 seule valeur => resultat connu !
  356.           IF(PROG(/1) .EQ. 1) THEN
  357.             VAINT = MLREE1.PROG(1)
  358.  
  359.           ELSE
  360.  
  361.             DO 200 IP=2,PROG(/1)
  362.               I1=IP
  363.               IF (PROG(IP).GT.VA1) GOTO 210
  364.  200        CONTINUE
  365.  210        CONTINUE
  366.             I2=I1-1
  367.             IF(PROG(I1)-PROG(I2).EQ.0.) THEN
  368.                KERRE = 835
  369.                IF (INEW.EQ.1) THEN
  370.                  SEGSUP MLREEL,MLREE1
  371.                ENDIF
  372.                RETURN
  373.             ENDIF
  374.             PENTE=(MLREE1.PROG(I1)-MLREE1.PROG(I2))/
  375.      &                  (PROG(I1)-PROG(I2))
  376.             VAINT=MLREE1.PROG(I2)+PENTE*(VA1-PROG(I2))
  377. *           kich : valeur hors segment Valeur egale a la borne depassee
  378.             if (va1.lt.prog(1)) vaint=MLREE1.PROG(1)
  379.             if (va1.gt.prog(prog(/1))) vaint=MLREE1.PROG(PROG(/1))
  380. *            write(6,fmt='(1X,''IGAU,IEL,VA1,VEL2'',2I6,2E13.5)')
  381. *                               IGAU,IEL,VA1,VAINT
  382.           ENDIF
  383.  
  384.           IF (INEW.EQ.1) THEN
  385.             SEGSUP MLREEL,MLREE1
  386.           ENDIF
  387.          endif
  388.  
  389.           IF (ICHAN.EQ.1) THEN
  390.             VEL2(IGAU,IEL)=VAINT
  391.           ELSE
  392.             VELCHE(IGAU,IEL)=VAINT
  393.           ENDIF
  394.  
  395.  180    CONTINUE
  396.  170  CONTINUE
  397. C  On change les valeurs interpolées au support demandé
  398.       IF (ICHAN.EQ.1) THEN
  399.         N1PAUX=N1PTE3
  400.         IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  401.         DO 220 IEL=1,MXNBE
  402.           DO 230 IGAU=1,N1PTE3
  403.             VAL1(IGAU)=VEL2(IGAU,IEL)
  404.  230      CONTINUE
  405.           IF (MINTE1.NE.0) THEN
  406.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  407.             CALL QUEDIM(MELGEO,KERRE)
  408.             CALL CH1CH2(MELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBNN,SWORK,
  409.      &                    IPOIN1,KERRE)
  410.             IF (KERRE.NE.0) THEN
  411.               SEGSUP IAMOI
  412.               RETURN
  413.             ENDIF
  414.             DO 240 IGAU=1,N1PTEL
  415.               VELCHE(IGAU,IEL)=VAL2(IGAU)
  416.  240        CONTINUE
  417.           ELSE
  418.             DO 250 IGAU=1,N1PTEL
  419.               VALG=0.D0
  420.               DO 260 INO=1,NBNN
  421.                 VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  422.  260          CONTINUE
  423.               VELCHE(IGAU,IEL)=VALG
  424.  250        CONTINUE
  425.           ENDIF
  426.  220    CONTINUE
  427.       ENDIF
  428.  
  429.       END
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  

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