Sources Esope | Cast3M

aleat1
C ALEAT1    SOURCE    PV        22/04/15    17:10:46     11344          
* CREATION D'UN 'CHPOINT' A VALEURS QUELCONQUES.
      SUBROUTINE ALEAT1 (IPRIGI,IPCHPO)
************************************************************************
*
*                             A L E A T 1
*                             -----------
*
* FONCTION:
* ---------
*
*     CREER UN 'CHPOINT' A VALEURS QUELCONQUES A PARTIR DE LA DONNEE
*     D'UNE 'RIGIDITE'.
*
* MODE D'APPEL:
* -------------
*
*     CALL ALEAT1 (IPRIGI,IPCHPO)
*
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPRIGI  ENTIER    (E)  POINTEUR D'UNE 'RIGIDITE'.
*     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, TDRAND, VCH1.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     5 OCTOBRE 1984
*
* 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
*
*      PARAMETER (LFIRST = 9)
*
*      SAVE JFIRST
*
*      DATA JFIRST/1/
      REAL*8 V
      integer insym
      insym = 0
      xspetl = xspeti
*
*     -- DETERMINATION DU NOMBRE D'INCONNUES DU PROBLEME TRAITE --
*
      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 QUELCONQUE, DE DIMENSION EGALE A
*     CELLE DU PROBLEME TRAITE --
*
      SEGINI,MVECTD
      IPVECT = MVECTD
      DO 100 IB=1,INC
         CALL TDRAND(V)
         VECTBB(IB) = V
  100    CONTINUE
*      write(6,*) ' vectbb sortie de trandd'
*      write(6,*) (vectbb (ib),ib=1,inc)
 
*     END DO
      SEGDES,MVECTD
*
*      IF (JFIRST .EQ. LFIRST) THEN
*         JFIRST = 1
*      ELSE
*         JFIRST = JFIRST + 1
*      END IF
*
*     -- TRANSFORMATION DU VECTEUR EN CHPOINT ALEATOIRE --
*
      CALL VCH1 (IPMATR,IPVECT,  IPCHPO,IPRIGI)
      IF (IERR .NE. 0) RETURN
*
      MVECTD = IPVECT
      SEGSUP,MVECTD
*
      END