C VARIN2    SOURCE    AM        11/08/22    21:15:02     7106           
      SUBROUTINE VARIN2(ICHAM2,MELVA1,COQ,MELEME,SWORK,NOMCO,MELE,
     &                  MELGEO,MINTE,MINTE1,MELVAL,KERRE)
*____________________________________________________________________
*
*  OBJET :  Variation d'un champ/élément ayant une ou des composante(s)
*  °°°°°°°   de type EVOLUTION en fonction d'un champ/point ou 
*            d'un champ/élément.Ce champ peut avoir plusieurs composantes 
*            si necessaire. Dans ce cas il est possible d'instancier 
*            un champ/element dont les composantes dependent de 
*            parametres differents en chaque point.
*           Routine appelee par varinu.eso
*
*
*  SORTIE :
*  °°°°°°°°
*
*     MELVAL  Pointeur sur le MCHAML resultat
*     KERRE   Diagnostic d'erreur
*
*_____________________________________________________________________
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC SMCHAML
-INC CCOPTIO
-INC SMEVOLL
-INC SMLREEL
-INC SMELEME
-INC SMINTE
-INC SMCOORD
C
      CHARACTER*8 NOMCO,NOM2,NOM3,NOM4,NOMTT
      LOGICAL COQ
C
C  Creation des segments
      SEGMENT SWORK
         REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBNN)
         REAL*8 SHP(6,NBNN) ,XE(3,NBNN)
      ENDSEGMENT
      SEGMENT IAMOI
         REAL*8 VEL1(MG1,N1EL2),VEL2(MG2,MXNBE)
      ENDSEGMENT
C
      DATA NOMTT/'T       '/
C
      KERRE=0
      ICHAN=0
C
      MCHAM2=ICHAM2
      SEGACT MCHAM2
      NBNN  =NUM(/1)
      NEL0=NUM(/2)
      NBPGAU=SHPTOT(/3)
      N1PTE3=MELVA1.IELCHE(/1)
      N1EL3 =MELVA1.IELCHE(/2)
      NCO1 = MCHAM2.IELVAL(/1)
      IEVOL = MELVA1.IELCHE(1,1)
      MEVOLL = IEVOL
      SEGACT MEVOLL
      KEVOLL = IEVOLL(1)
      SEGACT KEVOLL
      NOM3 = NOMEVY(1:8)
      NOM4 = NOMEVX(1:8)
      SEGDES KEVOLL
      SEGDES MEVOLL
C
C  Cas des coques dont les caracteristiques dependent de T
C
      IF (COQ.AND.NOM4.EQ.NOMTT) THEN
        INO2 = 0
        INO1 = 0
        INO3 = 0
        DO 10 INO = 1,NCO1
          NOM2 = MCHAM2.NOMCHE(INO)
          IF (NOM2.EQ.NOMTT     ) INO2=INO
          IF (NOM2.EQ.'TINF    ') INO1=INO
          IF (NOM2.EQ.'TSUP    ') INO3=INO
  10    CONTINUE
        IF (INO1.NE.0.AND.INO2.NE.0.AND.INO3.NE.0) THEN
C
          MELVA3=MCHAM2.IELVAL(INO1)  
          MELVA4=MCHAM2.IELVAL(INO3) 
          SEGACT MELVA3,MELVA4
C
          NBP2=MELVA4.VELCHE(/1) 
          NBP1=MELVA3.VELCHE(/1)                                                 
          NEL1=MELVA3.VELCHE(/2)                                                 
          NEL2=MELVA4.VELCHE(/2)                                                 
          N1PTEL=MAX(NBP1,NBP2)                                                  
          N1EL  =MAX(NEL1,NEL2)                                                  
          N2PTEL=0                                                               
          N2EL  =0                                                               
          SEGINI MELVA5                                                          
          DO 20 IGAU=1,N1PTEL                                                     
            IGMN1=MIN(IGAU,MELVA3.VELCHE(/1))                                   
            IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))                                   
            DO 30 IB=1,N1EL
              IBMN1=MIN(IB,MELVA3.VELCHE(/2))                                
              IBMN2=MIN(IB,MELVA4.VELCHE(/2))
              MELVA5.VELCHE(IGAU,IB)=MELVA3.VELCHE(IGMN1,IBMN1)+                      
     &                               MELVA4.VELCHE(IGMN2,IBMN2)                    
  30        CONTINUE  
  20      CONTINUE  
C
          SEGDES MELVA3,MELVA4
          MELVA3=MCHAM2.IELVAL(INO2)
          SEGACT MELVA3  
C
          N1PTEL = MELVA3.VELCHE(/1)
          N1EL = MELVA3.VELCHE(/2)
          N2PTEL = 0
          N2EL = 0
          SEGINI MELVA4
          DO 40 II = 1,N1PTEL
            DO 50 III = 1,N1EL
              MELVA4.VELCHE(II,III) = 4.D0*MELVA3.VELCHE(II,III)
  50        CONTINUE
  40      CONTINUE
          SEGDES MELVA3
C
          NBP2=MELVA4.VELCHE(/1) 
          NBP1=MELVA5.VELCHE(/1)                                                 
          NEL1=MELVA5.VELCHE(/2)                                                 
          NEL2=MELVA4.VELCHE(/2)                                                 
          N1PTEL=MAX(NBP1,NBP2)                                                  
          N1EL  =MAX(NEL1,NEL2)                                                  
          N2PTEL=0                                                               
          N2EL  =0                                                               
          SEGINI MELVA6                                                          
          DO 60 IGAU=1,N1PTEL                                                     
            IGMN1=MIN(IGAU,MELVA5.VELCHE(/1))                                   
            IGMN2=MIN(IGAU,MELVA4.VELCHE(/1))                                   
            DO 70 IB=1,N1EL                                                                                                                                     
              IBMN1=MIN(IB,MELVA5.VELCHE(/2))                                
              IBMN2=MIN(IB,MELVA4.VELCHE(/2))                                                                                                               
              MELVA6.VELCHE(IGAU,IB)=MELVA5.VELCHE(IGMN1,IBMN1)+                      
     &                               MELVA4.VELCHE(IGMN2,IBMN2)                    
  70        CONTINUE  
  60      CONTINUE  
          SEGSUP MELVA4,MELVA5
C
          N1PTEL = MELVA6.VELCHE(/1)
          N1EL = MELVA6.VELCHE(/2)
          N2PTEL = 0
          N2EL = 0
          SEGINI MELVA2
          DO 80 II = 1,N1PTEL
            DO 90 III = 1,N1EL
              MELVA2.VELCHE(II,III) = 1.D0/6.D0*MELVA6.VELCHE(II,III)
  90        CONTINUE
  80      CONTINUE  
          SEGSUP MELVA6
C
          GOTO 100
        ELSEIF (INO2.NE.0) THEN
          MELVA2=MCHAM2.IELVAL(INO2)
          SEGACT MELVA2              
          GOTO 100            
        ENDIF 
      ELSE
        DO 110 INO = 1,NCO1
          NOM2 = MCHAM2.NOMCHE(INO)
          IF (NOM3.EQ.NOMCO.or.(nomco.eq.'MOCO'.and.NOM3.eq.'RAID').or.
     &(nomco.eq.'MOCO'.and.NOM3.eq.'AMOR'))
     & THEN
            IF (NOM4.EQ.NOM2.OR.(NOM2.EQ.'TEMP'.AND.NOM4.EQ.'FREQ'))
     & THEN
              MELVA2=MCHAM2.IELVAL(INO)
              SEGACT MELVA2
              GOTO 100
            ENDIF
          ENDIF
 110    CONTINUE
      ENDIF
C
      SEGDES MCHAM2
      KERRE=665
      RETURN
C
 100  CONTINUE
C
C  On teste la taille de MCHAML_FLOTTANT
      N1PTE2=MELVA2.VELCHE(/1)
      N1EL2 =MELVA2.VELCHE(/2)
      IF (N1EL2.NE.NEL0.AND.N1EL2.NE.1.AND.NEL0.NE.1) THEN
        SEGDES MCHAM2,MELVA2
        KERRE=146
        RETURN
      ENDIF
      IF (N1PTE2.NE.1.AND.N1PTE2.NE.NBPGAU) THEN
        SEGDES MCHAM2,MELVA2
        KERRE=146
        RETURN
      ENDIF
C  On teste la taille entre MCHAML_EVOLUTION et MCHAML_FLOTTANT
      IF (N1EL2.NE.N1EL3.AND.N1EL2.NE.1.AND.N1EL3.NE.1) THEN
        SEGDES MCHAM2,MELVA2
        KERRE=146
        RETURN
      ENDIF
C  Si MCHAML_FLOTTANT ou la loi de variation n'est pas constant
C  et de plus leur support geometrique est different, alors on
C  change le support de MCHAML_FLOTTANT (MINTE) vers le support
C  de MCHAML_EVOLUTION (MINTE1). Quand l'interpolation est finie,
C  on change le support geometrique de MCHAML_FLOTTANT resultat
C  vers le support demandé (MINTE).
C  Tableau VEL1 contient les valeurs au support MINTE1
C  Tableau VEL2 contient les valeurs interpolées selon
C  la loi de variation et appuyées au support MINTE1
      MXNBE=MAX(N1EL2,N1EL3)
      IF (N1PTE3.NE.1.AND.MINTE.NE.MINTE1) THEN
        ICHAN=1
        IF (N1PTE2.EQ.1) THEN
          MG1=1
        ELSE
          MG1=N1PTE3
        ENDIF
        MG2=N1PTE3
        SEGINI IAMOI
        CALL ZERO(VEL1,MG1,N1EL2)
        CALL ZERO(VEL2,MG2,MXNBE)
C  Pour les COQ4, le nb de pt de GAUSS vaux 5, mais
C  on ne prend que les 4 premiers
        N1PAUX=N1PTE2
        IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
        DO 120 IEL=1,N1EL2
          IF (N1PTE2.EQ.1) THEN
            VEL1(1,IEL)=MELVA2.VELCHE(1,IEL)
          ELSE
            DO 130 IGAU=1,N1PTE2
              VAL1(IGAU)=MELVA2.VELCHE(IGAU,IEL)
 130        CONTINUE
            IF (MINTE1.NE.0) THEN
              CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
              CALL QUEDIM(MELGEO,KERRE)
              CALL CH1CH2(MELE,MINTE1,MINTE,N1PTE3,N1PAUX,NBNN,SWORK,
     &                    KERRE)
              IF (KERRE.NE.0) THEN
                SEGDES MCHAM2,MELVA2
                SEGSUP IAMOI
                RETURN
              ENDIF
              DO 140 IGAU=1,N1PTE3
                VEL1(IGAU,IEL)=VAL2(IGAU)
 140          CONTINUE
            ELSE
              DO 150 IGAU=1,N1PTE3
                VALG=0.D0
                DO 160 INO=1,NBNN
                  VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
 160            CONTINUE
                VEL1(IGAU,IEL)=VALG
 150          CONTINUE
            ENDIF
          ENDIF
 120    CONTINUE
      ELSE
        MG2=NBPGAU
        IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) MG2=1
      ENDIF
C  Recherche de la taille du nouveau chamelem
      N2PTEL=0
      N2EL  =0
      N1PTEL=NBPGAU
      N1EL  =MXNBE
      IF (N1PTE2.EQ.1.AND.N1PTE3.EQ.1) N1PTEL=1
      SEGINI MELVAL
C  Boucle sur les points de gauss et les éléments
      DO 170 IEL=1,MXNBE
        DO 180 IGAU=1,MG2
          IG=IGAU
          IF (N1PTE3.EQ.1) IG=1
          IE=IEL
          IF (N1EL3.EQ.1) IE=1
C  On active l'objet EVOLUTION
          IEVOL=MELVA1.IELCHE(IG,IE)
          MEVOLL=IEVOL
          SEGACT MEVOLL
          KEVOLL=IEVOLL(1)
          SEGACT KEVOLL
          MLREEL=IPROGX
          MLREE1=IPROGY
          SEGDES MEVOLL,KEVOLL
          SEGACT MLREEL,MLREE1
C
C
          INEW=0
          LON=PROG(/1)
C
C test pour renverser les suites si ls premiere est decroissante
C
          IF (PROG(LON) .LT. PROG(1)) THEN
            JG=LON
            JFIN=LON+1
            SEGINI MLREE2,MLREE3
            INEW=1
            DO 190 IO=1,LON
              MLREE2.PROG(IO)=PROG(JFIN-IO)
              MLREE3.PROG(IO)=MLREE1.PROG(JFIN-IO)
 190        CONTINUE
            SEGDES MLREEL,MLREE1
            MLREEL=MLREE2
            MLREE1=MLREE3
          ENDIF
C
C
C  On cherche la valeur à interpoler
          IF (ICHAN.EQ.1) THEN
            IG=IGAU
            IF (VEL1(/1).EQ.1) IG=1
            IE=IEL
            IF (VEL1(/2).EQ.1) IE=1
            VA1=VEL1(IG,IE)
          ELSE
            IG=IGAU
            IF (N1PTE2.EQ.1) IG=1
            IE=IEL
            IF (N1EL2.EQ.1) IE=1
            VA1=MELVA2.VELCHE(IG,IE)
          ENDIF
C
C  Interpolation linéaire
          DO 200 IP=2,PROG(/1)
            I1=IP
            IF (PROG(IP).GT.VA1) GOTO 210
 200      CONTINUE
 210      CONTINUE
          I2=I1-1
          IF(PROG(I1)-PROG(I2).EQ.0.) THEN
             KERRE = 835
             IF (INEW.EQ.1) THEN
               SEGSUP MLREEL,MLREE1
             ELSE
               SEGDES MLREEL,MLREE1
             ENDIF
             SEGDES MCHAM2,MELVA2
             RETURN
          ENDIF
          PENTE=(MLREE1.PROG(I1)-MLREE1.PROG(I2))/
     &                (PROG(I1)-PROG(I2))
          VAINT=MLREE1.PROG(I2)+PENTE*(VA1-PROG(I2))
* kich : valeur hors segment
**      AM  : ON MET UN MESSAGE D'ERREUR
          if (va1.lt.prog(1)) vaint=MLREE1.PROG(1)
          if (va1.gt.prog(prog(/1))) vaint=MLREE1.PROG(PROG(/1))
**        IF (va1.lt.prog(1).OR.
**   &        va1.gt.prog(prog(/1))) THEN
**           KERRE = 497
**           IF (INEW.EQ.1) THEN
**             SEGSUP MLREEL,MLREE1
**           ELSE
**             SEGDES MLREEL,MLREE1
**           ENDIF
**           SEGDES MCHAM2,MELVA2
**           RETURN
**        ENDIF
*
          IF (ICHAN.EQ.1) THEN
            VEL2(IGAU,IEL)=VAINT
          ELSE
            VELCHE(IGAU,IEL)=VAINT
          ENDIF
*            write(6,fmt='(1X,''IGAU,IEL,VA1,VEL2'',2I6,2E13.5)')
*                               IGAU,IEL,VA1,VAINT
C
          IF (INEW.EQ.1) THEN
            SEGSUP MLREEL,MLREE1
          ELSE
            SEGDES MLREEL,MLREE1
          ENDIF
 180    CONTINUE
 170  CONTINUE
C  On change les valeurs interpolées au support demandé
      IF (ICHAN.EQ.1) THEN
        N1PAUX=N1PTE3
        IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
        DO 220 IEL=1,MXNBE
          DO 230 IGAU=1,N1PTE3
            VAL1(IGAU)=VEL2(IGAU,IEL)
 230      CONTINUE
          IF (MINTE1.NE.0) THEN
            CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
            CALL QUEDIM(MELGEO,KERRE)
            CALL CH1CH2(MELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBNN,SWORK,
     &                  KERRE)
            IF (KERRE.NE.0) THEN
              SEGDES MCHAM2,MELVA2
              SEGSUP IAMOI
              RETURN
            ENDIF
            DO 240 IGAU=1,N1PTEL
              VELCHE(IGAU,IEL)=VAL2(IGAU)
 240        CONTINUE
          ELSE
            DO 250 IGAU=1,N1PTEL
              VALG=0.D0
              DO 260 INO=1,NBNN
                VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
 260          CONTINUE
              VELCHE(IGAU,IEL)=VALG
 250        CONTINUE
          ENDIF
 220    CONTINUE
      ENDIF
      SEGDES MELVA2,MELVAL
      SEGDES MCHAM2
C
      RETURN
      END