Sources Esope | Cast3M

unifo1
C UNIFO1    SOURCE    PV        22/04/15    17:10:56     11344          
* CREATION D'UN 'CHPOINT' UNIFORME.
      SUBROUTINE UNIFO1 (IPRIGI,XX,IPCHPO)
************************************************************************
*
*                             U N I F O 1
*                             -----------
*
* FONCTION:
* ---------
*
*     CREER UN 'CHPOINT' DE MEME VALEUR EN TOUT POINT DU SUPPORT
*     GEOMETRIQUE D'UNE 'RIGIDITE' DONNEE.
*
* MODE D'APPEL:
* -------------
*
*     CALL UNIFO1 (IPRIGI,XX,IPCHPO)
*
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPRIGI  ENTIER    (E)  POINTEUR D'UNE 'RIGIDITE'.
*     XX      REEL SP   (E)  VALEUR DU 'CHPOINT' EN TOUT POINT.
*     IPCHPO  ENTIER    (S)  POINTEUR DU 'CHPOINT' DETERMINE.
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     INC     ENTIER    NOMBRE D'INCONNUES DU PROBLEME.
*     IPMATR  ENTIER    POINTEUR SUR L'OBJET 'MATRICE' ASSOCIE A LA
*                       'RIGIDITE' DE POINTEUR "IPRIGI".
*     IPVECT  ENTIER    POINTEUR D'UN OBJET DE TRAVAIL 'VECTDOUB'.
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     TRIANG, VCH1.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     1ER AVRIL 1985
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRI
-INC SMRIGID
-INC SMVECTD
-INC CCREEL
*
*     -- DETERMINATION DU NOMBRE D'INCONNUES DU PROBLEME TRAITE --
*
      integer insym
      insym = 0
      xspetl = xspeti
      MRIGID = IPRIGI
      SEGACT,MRIGID
      NRG = IRIGEL(/1)
      NBR = IRIGEL(/2)
      IPMATR = ICHOLE
      IF(NORINC.GT.0  .AND. NORIND.GT.0) THEN
         INSYM = 1
      ENDIF
      IF (NRG.GE.7) THEN
         DO  9 IN = 1,NBR
            IANTI=IRIGEL(7,IN)
            IF(IANTI.GT.0) THEN
               INSYM = 1
            ENDIF
  9      CONTINUE
      ENDIF
      SEGDES,MRIGID
*
      IF (IPMATR .EQ. 0) THEN
        IF (INSYM .EQ. 0) THEN
         CALL TRIANG (IPRIGI,xspetl,0)
        ELSE
         CALL ldmt1(IPRIGI,xspetl)
        ENDIF
         IF (IERR .NE. 0) RETURN
         MRIGID = IPRIGI
         SEGACT,MRIGID
         IPMATR = ICHOLE
         SEGDES,MRIGID
      END IF
*
      MMATRI = IPMATR
      SEGACT,MMATRI
      MILIGN=IILIGN
      SEGDES,MMATRI
      SEGACT,MILIGN
      INC=IPNO(/1)
      SEGDES,MILIGN
*
*     -- DETERMINATION D'UN VECTEUR UNIFORME, DE DIMENSION EGALE A
*     CELLE DU PROBLEME TRAITE --
*
      SEGINI,MVECTD
      IPVECT = MVECTD
      DO 100 IB=1,INC
         VECTBB(IB) = XX
  100    CONTINUE
*     END DO
      SEGDES,MVECTD
*
*     -- TRANSFORMATION DU VECTEUR EN CHPOINT --
*
      CALL VCH1 (IPMATR,IPVECT,  IPCHPO,IPRIGI)
      IF (IERR .NE. 0) RETURN
*
      MVECTD = IPVECT
      SEGSUP,MVECTD
*
      END