Sources Esope | Cast3M

varipo
C VARIPO    SOURCE    CB215821  20/11/25    13:42:07     10792          
 
      SUBROUTINE VARIPO(IPOI1,IPOI2,MOT2,IPOI3)
 
C-----------------------------------------------------------------------
C                    CHPOINT VARIABLE
C-----------------------------------------------------------------------
C  ENTREES:
C     IPOI1=POINTEUR SUR UN CHPOINT
C     IPOI2=POINTEUR SUR UN EVOLUTIO
C     MOT2 =NOM DE COMPOSANTE A DONNER AU RESULTAT
C  SORTIE:
C     IPOI3=POINTEUR SUR LE CHPOINT RESULTAT
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCOORD
-INC SMCHPOI
-INC SMEVOLL
-INC SMLREEL
-INC SMELEME
 
      CHARACTER*(*) MOT2
      CHARACTER*(LOCOMP) MOTREF,MOTABS,MOTORD
 
      SEGMENT mwrk
        INTEGER ipoi(NBPTS)
        REAL*8  xpoi(NBPTS)
      ENDSEGMENT
 
      IPOI3 = 0
C
C  ON RECUPERE L'OBJET EVOLUTION
C
      MEVOLL = IPOI2
      SEGACT,MEVOLL
      KEVOLL = mevoll.IEVOLL(1)
      SEGDES,MEVOLL
      SEGACT,KEVOLL
      IF (kevoll.TYPX .NE. 'LISTREEL' .OR.
     &    kevoll.TYPY .NE. 'LISTREEL') THEN
        SEGDES,KEVOLL
        MOTERR(1:8) = 'LISTREEL'
        CALL ERREUR(37)
        RETURN
      ENDIF
      MLREE1 = kevoll.IPROGX
      MLREE2 = kevoll.IPROGY
      MOTABS = kevoll.NOMEVX
      IF (MOT2.NE.'    ') THEN
        MOTORD = MOT2
      ELSE
        MOTORD = kevoll.NOMEVY(1:4)
      ENDIF
      SEGDES,KEVOLL
* Petites verifications sur le contenu de l'evolution
      SEGACT,MLREE1,MLREE2
      NBPOIX = MLREE1.PROG(/1)
      NBPOIY = MLREE2.PROG(/1)
      IF (NBPOIX.NE.NBPOIY) THEN
        CALL ERREUR(577)
        GOTO 999
      ENDIF
      JORDO = 0
      CALL VARIFV(MLREE1.PROG,NBPOIX, JORDO)
      IF (JORDO.EQ.0) THEN
        CALL ERREUR(872)
        GOTO 999
      ENDIF
C
C  ON RECUPERE LE CHPOINT
C
      MCHPO1 = IPOI1
      SEGACT,MCHPO1
C
C Quelques verifications sur le CHPOINT d'entree
      NSOUP1 = MCHPO1.IPCHP(/1)
C CHPOINT "VIDE" -> ERREUR 
      IF (NSOUP1.LE.0) THEN
        MOTERR(1:8) = 'CHPOINT '
        INTERR(1) = IPOI1
        CALL ERREUR(356)
        GOTO 998
      ENDIF
C On active le CHPOINT d'entree (son entete) :
C On regarde si on a une seule composante pour tout le champ.
      IBVAL = 0
      DO 10 IA = 1, NSOUP1
        MSOUP1 = MCHPO1.IPCHP(IA)
        SEGACT,MSOUP1
        NC1 = MSOUP1.NOCOMP(/2)
        IF (NC1.EQ.1) THEN
          IBVAL = IBVAL + 1
          IF (IBVAL.EQ.1) MOTREF = MSOUP1.NOCOMP(1)
        ENDIF
 10   CONTINUE
C Si le champ a plus d'une composante, on va rechercher celle qui
C correspond a l'abscisse de l'evolution.
      IF (IBVAL.NE.NSOUP1) MOTREF = MOTABS
C
C "Petit" segment de travail :
      SEGINI,mwrk
C
C     BOUCLE SUR LES SOUS-ZONES DU CHPOINT
C
      NBPOI3 = 0
C
      DO 100 IA = 1, NSOUP1
C
        MSOUP1 = MCHPO1.IPCHP(IA)
        NC1    = MSOUP1.NOCOMP(/2)
        IF (NC1.LE.0) GOTO 100
        IBVAL = 0
        CALL PLACE(MSOUP1.NOCOMP(1),NC1,IBVAL,MOTREF)
        IF (IBVAL.LE.0) GOTO 100
 
        MELEME = MSOUP1.IGEOC
        MPOVAL = MSOUP1.IPOVAL
        SEGACT,MELEME,MPOVAL
        NBNN   = meleme.NUM(/1)
        NBELEM = meleme.NUM(/2)
        N      = mpoval.VPOCHA(/1)
        NC     = mpoval.VPOCHA(/2)
C
C Verification sur LES DIMENSIONS DU CHPOINT :
C Ne devrait pas arriver sauf si le chpoint n'est pas bien cree par on
C ne sait quel operateur ou operation ou autre bizarrerie...
        IF (N.NE.NBELEM .OR. NBNN.NE.1 .OR. NC1.NE.NC) THEN
          SEGDES,MELEME,MPOVAL
          MOTERR(1:8) = 'VARIPO'
          CALL ERREUR(178)
          CALL ERREUR(5)
          GOTO 997
        ENDIF
 
        DO 110 IC = 1, N
          XTT1 = mpoval.VPOCHA(IC,IBVAL)
          CALL VARIFO(MLREE1.PROG,MLREE2.PROG,NBPOIX,JORDO,XTT1,
     &                YTT1)
          NBPOI3 = NBPOI3 + 1
C* Ici on ne verifie pas que le point n'a pas deja ete rencontre.
          mwrk.ipoi(NBPOI3) = meleme.NUM(1,IC)
          mwrk.xpoi(NBPOI3) = YTT1
 110    CONTINUE
 
        SEGDES,MELEME,MPOVAL
 
 100  CONTINUE
C
C     ERREUR SI LA COMPOSANTE RECHERCHEE N'EST PAS DANS MCHPOI
      IF (NBPOI3.EQ.0) THEN
        MOTERR= MOTABS
        CALL ERREUR(181)
        GOTO 997
      ENDIF
C
C     ON REMPLIT LE CHPOINT DE SORTIE
C
      NSOUPO = 1
      NAT    = MCHPO1.JATTRI(/1)
      SEGINI,MCHPOI
      mchpoi.MTYPOI = 'SCALAIRE'
      mchpoi.MOCHDE = 'CHPOINT cree par VARIPO'
      DO 200 IA = 1, NAT
        mchpoi.JATTRI(IA) = MCHPO1.JATTRI(IA)
 200  CONTINUE
      mchpoi.IFOPOI = MCHPO1.IFOPOI
      NC = 1
      SEGINI,MSOUPO
      mchpoi.IPCHP(1) = MSOUPO
      msoupo.NOCOMP(1)= MOTORD
      NBNN   = 1
      NBELEM = NBPOI3
      NBSOUS = 0
      NBREF  = 0
      SEGINI,MELEME
      meleme.ITYPEL = 1
      N     = NBPOI3
      NC    = 1
      SEGINI,MPOVAL
      DO 210 IC = 1, NBPOI3
        meleme.NUM(1,IC)    = mwrk.ipoi(IC)
        mpoval.VPOCHA(IC,1) = mwrk.xpoi(IC)
  210 CONTINUE
      CALL CRECH1(meleme,1)
      SEGDES,MELEME,MPOVAL
      msoupo.IGEOC  = MELEME
      msoupo.IPOVAL = MPOVAL
      SEGDES,MSOUPO,MCHPOI
      IPOI3 = MCHPOI
C
C  On ferme tous les segments restants (et on detruit les inutiles).
 997  CONTINUE
      SEGSUP,mwrk
      DO 9970 IA = 1, NSOUP1
        MSOUP1 = MCHPO1.IPCHP(IA)
        SEGDES,MSOUP1
 9970 CONTINUE
 998  CONTINUE
      SEGDES,MCHPO1
 999  CONTINUE
      SEGDES,MLREE1,MLREE2
 
      RETURN
      END