1 : C ALEA2 SOURCE CHAT 11/03/16 21:15:22 6902 2 : SUBROUTINE ALEA2 3 : & (MELENT,LADIM,XDIR1,XDIR2,XDIR3,ZSIG,CLAMD1,CLAMD2,CLAMD3,VALMOY, 4 : & DELZET,OMMAX) 5 : C 6 : C======================================================================= 7 : C 8 : C Subroutine ALEA2 : génération d'un CHPOINT aléatoire 9 : C 10 : C Appellée par ALEA 11 : C 12 : C--------------------- 13 : C Variables internes : 14 : C--------------------- 15 : C 16 : C NBEL : nombre d'éléments 17 : C NBPT : nombre de noeuds par éléments 18 : C NBPGAU : nombre de valeurs à stocker par élément 19 : C 20 : C IPTABL : pointeur sur la table domaine, si elle existe 21 : C 22 : C======================================================================= 23 : C 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : REAL*8 ZDIST, VALMOY, OMMAX 27 : C 28 : -INC CCOPTIO 29 : -INC CCREEL 30 : -INC CCGEOME 31 : -INC SMELEME 32 : -INC SMCOORD 33 : -INC SMMODEL 34 : -INC SMCHPOI 35 : -INC SMTABLE 36 : -INC SMINTE 37 : 38 : C Table des coordonnées des points supports 39 : SEGMENT TABCOR 40 : REAL*8 COR(NBL,3) 41 : ENDSEGMENT 42 : 43 : C Table des valeurs en ces points 44 : SEGMENT TABVAL 45 : REAL*8 VAL(NBL) 46 : ENDSEGMENT 47 : 48 : DIMENSION XDIR1(3),XDIR2(3),XDIR3(3) 49 : POINTEUR MELENT.MELEME, MELSUP.MELEME 50 : C 51 : C epsilon servant à différents tests 52 : EPS = 1.D-12 53 : 54 : * --------- 55 : * 2. On construit les coordonnées des points supports 56 : * on initialise le champ résultat en parallèle (CHPOINT) 57 : 58 : * On tire du maillage les points supports voulus 59 : * en changeant le maillage en POI1 si ce n'est déjà fait. 60 : MELSUP = MELENT 61 : SEGACT MELENT 62 : IF (MELENT.ITYPEL.NE.1) THEN 62 : CALL CHANGE(MELSUP,1) 63 : ENDIF 64 : SEGDES MELENT 65 : * 66 : * 2a. Construction des coordonnnées des points supports : 67 : * 68 : * MELSUP est un maillage simple de POI1 69 : * Les points existent, et leurs coordonnées sont dans XCOOR. 70 : SEGACT MELSUP 71 : NBL = MELSUP.NUM(/2) 72 : SEGINI TABCOR 73 : DO 9 I=1,NBL 74 : IREF = (IDIM+1) * (MELSUP.NUM(1,I)-1) 75 : DO 11 K=1,IDIM 76 : COR(I,K) = XCOOR(IREF+K) 77 : 11 CONTINUE 78 : 9 CONTINUE 79 : SEGDES MELSUP 80 : * 81 : * 2b. Transformation des coordonnées dans le repère adimensionné 82 : * par la matrice lambda de dimension LADIM. 83 : * 84 : IF (IDIM.EQ.2) THEN 85 : IF (LADIM.EQ.1) THEN 86 : * 2D stat 1D 87 : DO 20 L=1,NBL 88 : XX = COR(L,1) 89 : YY = COR(L,2) 90 : COR(L,1) = ((XX * XDIR1(1)) + (YY * XDIR1(2))) / CLAMD1 91 : 20 CONTINUE 92 : ELSE 93 : * 2D stat 2D 94 : DO 21 L=1,NBL 95 : XX = COR(L,1) 96 : YY = COR(L,2) 97 : COR(L,1) = ((XX * XDIR1(1)) + (YY * XDIR1(2))) / CLAMD1 98 : COR(L,2) = ((XX * XDIR2(1)) + (YY * XDIR2(2))) / CLAMD2 99 : 21 CONTINUE 100 : ENDIF 101 : ELSE 102 : IF (LADIM.EQ.1) THEN 103 : * 3D stat 1D 104 : DO 22 L=1,NBL 105 : XX = COR(L,1) 106 : YY = COR(L,2) 107 : ZZ = COR(L,3) 108 : COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2)) 109 : & + (ZZ * XDIR1(3)) ) / CLAMD1 110 : 22 CONTINUE 111 : ELSEIF (LADIM.EQ.2) THEN 112 : * 3D stat 2D 113 : DO 23 L=1,NBL 114 : XX = COR(L,1) 115 : YY = COR(L,2) 116 : ZZ = COR(L,3) 117 : COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2)) 118 : & + (ZZ * XDIR1(3)) ) / CLAMD1 119 : COR(L,2) = ( (XX * XDIR2(1)) + (YY * XDIR2(2)) 120 : & + (ZZ * XDIR2(3)) ) / CLAMD2 121 : 23 CONTINUE 122 : ELSE 123 : * 3D stat 3D 124 : DO 24 L=1,NBL 125 : XX = COR(L,1) 126 : YY = COR(L,2) 127 : ZZ = COR(L,3) 128 : COR(L,1) = ( (XX * XDIR1(1)) + (YY * XDIR1(2)) 129 : & + (ZZ * XDIR1(3)) ) / CLAMD1 130 : COR(L,2) = ( (XX * XDIR2(1)) + (YY * XDIR2(2)) 131 : & + (ZZ * XDIR2(3)) ) / CLAMD2 132 : COR(L,3) = ( (XX * XDIR3(1)) + (YY * XDIR3(2)) 133 : & + (ZZ * XDIR3(3)) ) / CLAMD3 134 : 24 CONTINUE 135 : ENDIF 136 : ENDIF 137 : 138 : * 2c. En-tête du CHPO (Diffus, comp. 'SCAL') 139 : NAT = 1 140 : NSOUPO = 1 141 : SEGINI MCHPOI 142 : MTYPOI = ' ' 143 : MOCHDE = 'Champ-point cree par l operateur ALEA' 144 : JATTRI(1) = 1 145 : IFOPOI = IFOUR 146 : NC = 1 147 : SEGINI MSOUPO 148 : IPCHP(1) = MSOUPO 149 : NOCOMP(1) = 'SCAL' 150 : * NOCONS(1) = pas de nom de constituant 151 : IGEOC = MELSUP 152 : NOHARM(1) = NIFOUR 153 : N = NBL 154 : SEGINI MPOVAL 155 : IPOVAL = MPOVAL 156 : 157 : * --------- 158 : * 3. Génération aléatoire : 159 : * 159 : CALL BANTOU(TABCOR,TABVAL,LADIM,ZSIG,VALMOY,DELZET,OMMAX) 160 : SEGDES TABCOR 161 : * 162 : * --------- 163 : * 4. Construction champ résultat : 164 : * 165 : * BANTOU renvoie le résultat sous la forme d'une table de valeur, 166 : * TABVAL active, que l'on doit maintenant convertir en MPOVAL. 167 : DO 2 IEL=1,NBL 168 : VPOCHA(IEL,1) = VAL(IEL) 169 : 2 CONTINUE 170 : 171 : SEGDES MPOVAL,MSOUPO,MCHPOI 172 : SEGSUP TABVAL 173 : 174 : * --------- 175 : * 5. Ecriture en sortie 176 : * 176 : CALL ECROBJ('CHPOINT ',MCHPOI) 177 : 178 : RETURN 179 : END 180 : 181 : 182 : 183 : 184 : 185 : 186 : 187 : 188 : 189 : 190 : 191 : 192 :
© Cast3M 2003 - All rights reserved.
Disclaimer