Sources Esope | Cast3M

alea2
C ALEA2     SOURCE    CB215821  24/04/12    21:15:04     11897          
      SUBROUTINE ALEA2
     & (MELENT,LADIM,XDIR1,XDIR2,XDIR3,ZSIG,CLAMD1,CLAMD2,CLAMD3,VALMOY,
     &  DELZET,OMMAX)
C
C=======================================================================
C
C  Subroutine ALEA2 : génération d'un CHPOINT aléatoire
C
C  Appellée par ALEA
C
C---------------------
C Variables internes :
C---------------------
C
C  NBEL   : nombre d'éléments
C  NBPT   : nombre de noeuds par éléments
C  NBPGAU : nombre de valeurs à stocker par élément
C
C  IPTABL : pointeur sur la table domaine, si elle existe
C
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      REAL*8 ZDIST, VALMOY, OMMAX
C
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC CCGEOME
-INC SMELEME
-INC SMCOORD
-INC SMMODEL
-INC SMCHPOI
-INC SMTABLE
-INC SMINTE
 
C     Table des coordonnées des points supports
      SEGMENT TABCOR
        REAL*8  COR(NBL,3)
      ENDSEGMENT
 
C     Table des valeurs en ces points
      SEGMENT TABVAL
        REAL*8  VAL(NBL)
      ENDSEGMENT
 
      DIMENSION    XDIR1(3),XDIR2(3),XDIR3(3)
      POINTEUR     MELENT.MELEME, MELSUP.MELEME
C
C     epsilon servant à différents tests
      EPS = 1.D-12
 
*     ---------
*     2. On construit les coordonnées des points supports
*        on initialise le champ résultat en parallèle (CHPOINT)
 
*     On tire du maillage les points supports voulus
*     en changeant le maillage en POI1 si ce n'est déjà fait.
      MELSUP = MELENT
      SEGACT MELENT
      IF (MELENT.ITYPEL.NE.1) THEN
        CALL CHANGE(MELSUP,1)
      ENDIF
      SEGDES MELENT
*
*     2a. Construction des coordonnnées des points supports :
*
*     MELSUP est un maillage simple de POI1
*     Les points existent, et leurs coordonnées sont dans XCOOR.
      SEGACT MELSUP
      NBL = MELSUP.NUM(/2)
      SEGINI TABCOR
      SEGACT,MCOORD
      DO 9 I=1,NBL
        IREF = (IDIM+1) * (MELSUP.NUM(1,I)-1)
        DO 11 K=1,IDIM
          COR(I,K) = XCOOR(IREF+K)
 11     CONTINUE
 9    CONTINUE
      SEGDES MELSUP,MCOORD
*
*     2b. Transformation des coordonnées dans le repère adimensionné
*         par la matrice lambda de dimension LADIM.
*
      IF (IDIM.EQ.2) THEN
        IF (LADIM.EQ.1) THEN
*         2D stat 1D
          DO 20 L=1,NBL
            XX = COR(L,1)
            YY = COR(L,2)
            COR(L,1) = ((XX * XDIR1(1)) + (YY * XDIR1(2))) / CLAMD1
 20       CONTINUE
        ELSE
*         2D stat 2D
          DO 21 L=1,NBL
            XX = COR(L,1)
            YY = COR(L,2)
            COR(L,1) = ((XX * XDIR1(1)) + (YY * XDIR1(2))) / CLAMD1
            COR(L,2) = ((XX * XDIR2(1)) + (YY * XDIR2(2))) / CLAMD2
 21       CONTINUE
        ENDIF
      ELSE
        IF (LADIM.EQ.1) THEN
*         3D stat 1D
          DO 22 L=1,NBL
            XX = COR(L,1)
            YY = COR(L,2)
            ZZ = COR(L,3)
            COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2))
     &                 + (ZZ * XDIR1(3)) ) / CLAMD1
 22       CONTINUE
        ELSEIF (LADIM.EQ.2) THEN
*         3D stat 2D
          DO 23 L=1,NBL
            XX = COR(L,1)
            YY = COR(L,2)
            ZZ = COR(L,3)
            COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2))
     &                 + (ZZ * XDIR1(3)) ) / CLAMD1
            COR(L,2) = ( (XX * XDIR2(1)) + (YY * XDIR2(2))
     &                 + (ZZ * XDIR2(3)) ) / CLAMD2
 23       CONTINUE
        ELSE
*         3D stat 3D
          DO 24 L=1,NBL
            XX = COR(L,1)
            YY = COR(L,2)
            ZZ = COR(L,3)
            COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2))
     &                 + (ZZ * XDIR1(3)) ) / CLAMD1
            COR(L,2) = ( (XX * XDIR2(1)) + (YY * XDIR2(2))
     &                 + (ZZ * XDIR2(3)) ) / CLAMD2
            COR(L,3) = ( (XX * XDIR3(1)) + (YY * XDIR3(2))
     &                 + (ZZ * XDIR3(3)) ) / CLAMD3
 24       CONTINUE
        ENDIF
      ENDIF
 
*     2c. En-tête du CHPO (Diffus, comp. 'SCAL')
      NAT    = 1
      NSOUPO = 1
      SEGINI MCHPOI
      MTYPOI    = ' '
      MOCHDE    = 'Champ-point cree par l operateur ALEA'
      JATTRI(1) = 1
      IFOPOI    = IFOUR
      NC        = 1
      SEGINI MSOUPO
      IPCHP(1)  = MSOUPO
      NOCOMP(1) = 'SCAL'
      IGEOC     = MELSUP
      NOHARM(1) = NIFOUR
      N         = NBL
      SEGINI MPOVAL
      IPOVAL = MPOVAL
 
*     ---------
*     3. Génération aléatoire :
*
      CALL BANTOU(TABCOR,TABVAL,LADIM,ZSIG,VALMOY,DELZET,OMMAX)
      SEGDES TABCOR
*
*     ---------
*     4. Construction champ résultat :
*
*     BANTOU renvoie le résultat sous la forme d'une table de valeur,
*     TABVAL active, que l'on doit maintenant convertir en MPOVAL.
      DO 2 IEL=1,NBL
        VPOCHA(IEL,1) = VAL(IEL)
 2    CONTINUE
 
      SEGDES MPOVAL,MSOUPO,MCHPOI
      SEGSUP TABVAL
 
*     ---------
*     5. Ecriture en sortie
*
      CALL ACTOBJ('CHPOINT ',MCHPOI,1)
      CALL ECROBJ('CHPOINT ',MCHPOI)
 
      END