1 : C RLEXF3 SOURCE PV 09/03/12 21:33:54 6325 2 : SUBROUTINE RLEXF3(MCHCEN,MCHLI1,MCHLI2,MCHNOR,MCHELM,MCHGRA) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : RLEXF3 8 : C 9 : C DESCRIPTION : Appelle par PENDI3 10 : C 11 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 12 : C 13 : C AUTEUR : A. BECCANTINI 14 : C 15 : C************************************************************************ 16 : C 17 : C Inputs: 18 : C 19 : C MCHGRA : CHAMPOINT we want to compute the gradient of which 20 : C 21 : C MCHLI1 : CHAMPOINT Dirichlet BC 22 : C 23 : C MCHLI2 : CHAMPOINT: VN BC 24 : C 25 : C MCHNOR : CHAMPOINT: interfaces normales 26 : C 27 : C MCHELM : MCHAML which contains the coeff. to coppute the gradient 28 : C 29 : C Output: 30 : C 31 : C MCHGRA : CHAMPOINT, gradient of MCHGRA 32 : C 33 : C 34 : C**** Variables de COOPTIO 35 : C 36 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 37 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 38 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 39 : C & ,IECHO, IIMPI, IOSPI 40 : C & ,IDIM 41 : C & ,MCOORD 42 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 43 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 44 : C & ,NORINC,NORVAL,NORIND,NORVAD 45 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 46 : C 47 : IMPLICIT INTEGER(I-N) 48 : -INC CCOPTIO 49 : INTEGER NBNN, NBELEM 50 : -INC SMELEME 51 : -INC SMCHAML 52 : C 53 : -INC SMCHPOI 54 : POINTEUR MCHCEN.MCHPOI, MCHLI1.MCHPOI, MCHLI2.MCHPOI 55 : & ,MCHGRA.MCHPOI, MCHNOR.MCHPOI 56 : POINTEUR MPOCEN.MPOVAL, MPOLI1.MPOVAL, MPOLI2.MPOVAL,MPOGRA.MPOVAL 57 : & ,MPONOR.MPOVAL 58 : C 59 : -INC SMLENTI 60 : POINTEUR MLECEN.MLENTI, MLELI1.MLENTI,MLELI2.MLENTI,MLEGRA.MLENTI 61 : C 62 : INTEGER IGEOM, NCOM, ISOUS, NBSOUS, IELEM, IVOI, NGV, NLF 63 : & ,NLV,NLL1,NLL2,ICOM,I2,NLNO 64 : REAL*8 VAL 65 : CHARACTER*8 NOM1 66 : C 67 : C**** We read MCHCEN, MPOCEN (its MPOVAL) 68 : C and we create MLECEN 69 : C 69 : CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM) 70 : IF(IERR.NE.0)GOTO 9999 71 : NCOM=MPOCEN.VPOCHA(/2) 72 : C En LICHT SEGACT*MOD MPOCEN 72 : CALL KRIPAD(IGEOM,MLECEN) 73 : IF(IERR.NE.0)GOTO 9999 74 : C SEGACT IGEOM 75 : C SEGINI MLECEN 76 : MELEME=IGEOM 77 : SEGDES MELEME 78 : C 79 : C**** For the boundary conditions 80 : C 81 : C MPOLI1, MLELI1, 82 : C MPOLI2, MLELI2 83 : C 84 : IF(MCHLI1.GT.0)THEN 84 : CALL LICHT(MCHLI1,MPOLI1,NOM1,IGEOM) 85 : IF(IERR.NE.0)GOTO 9999 86 : C En LICHT SEGACT*MOD MPOLI1 86 : CALL KRIPAD(IGEOM,MLELI1) 87 : IF(IERR.NE.0)GOTO 9999 88 : C SEGACT IGEOM 89 : C SEGINI MLELI1 90 : MELEME=IGEOM 91 : SEGDES MELEME 92 : ELSE 93 : MPOLI1=0 93 : CALL KRIPAD(0,MLELI1) 94 : ENDIF 95 : C 96 : IF(MCHLI2.GT.0)THEN 96 : CALL LICHT(MCHLI2,MPOLI2,NOM1,IGEOM) 97 : IF(IERR.NE.0)GOTO 9999 98 : C En LICHT SEGACT*MOD MPOLI2 98 : CALL KRIPAD(IGEOM,MLELI2) 99 : IF(IERR.NE.0)GOTO 9999 100 : C SEGACT IGEOM 101 : C SEGINI MLELI2 102 : MELEME=IGEOM 103 : SEGDES MELEME 104 : ELSE 105 : MPOLI2=0 105 : CALL KRIPAD(0,MLELI2) 106 : ENDIF 107 : C 108 : C**** The gradient 109 : C 110 : C MPOGRA, MLEGRA 111 : C 111 : CALL LICHT(MCHGRA,MPOGRA,NOM1,IGEOM) 112 : IF(IERR.NE.0)GOTO 9999 113 : C En LICHT SEGACT*MOD MPOGRA 113 : CALL KRIPAD(IGEOM,MLEGRA) 114 : IF(IERR.NE.0)GOTO 9999 115 : C En KRIPAD 116 : C SEGACT IGEOM 117 : C SEGINI MLEGRA 118 : C 119 : MELEME=IGEOM 120 : SEGDES MELEME 121 : C 122 : C**** The normals 123 : C 124 : C MPONOR (same order as MPOGRA) 125 : C 125 : CALL LICHT(MCHNOR,MPONOR,NOM1,IGEOM) 126 : IF(IERR.NE.0)GOTO 9999 127 : C En LICHT SEGACT*MOD MPONOR 128 : C 129 : C**** Computation 130 : C 131 : SEGACT MCHELM 132 : NBSOUS=MCHELM.IMACHE(/1) 133 : C 134 : DO ISOUS=1,NBSOUS,1 135 : MELEME=MCHELM.IMACHE(ISOUS) 136 : MCHAM1=MCHELM.ICHAML(ISOUS) 137 : SEGACT MELEME 138 : SEGACT MCHAM1 139 : MELVA1=MCHAM1.IELVAL(1) 140 : MELVA2=MCHAM1.IELVAL(2) 141 : SEGACT MELVA1 142 : SEGACT MELVA2 143 : NOM1=MCHAM1.NOMCHE(1) 144 : IF(NOM1 .NE. 'alphax ')THEN 145 : WRITE(IOIMP,*) NOM1, '!=', 'alphax ' 146 : C 21 2 147 : C Données incompatibles 147 : CALL ERREUR(21) 148 : GOTO 9999 149 : ENDIF 150 : NOM1=MCHAM1.NOMCHE(2) 151 : IF(NOM1 .NE. 'alphay ')THEN 152 : WRITE(IOIMP,*) NOM1, '!=', 'alphay ' 153 : C 21 2 154 : C Données incompatibles 154 : CALL ERREUR(21) 155 : GOTO 9999 156 : ENDIF 157 : IF(IDIM.EQ.3)THEN 158 : MELVA3=MCHAM1.IELVAL(3) 159 : SEGACT MELVA3 160 : NOM1=MCHAM1.NOMCHE(3) 161 : IF(NOM1 .NE. 'alphaz ')THEN 162 : WRITE(IOIMP,*) NOM1, '!=', 'alphaz ' 163 : C 21 2 164 : C Données incompatibles 164 : CALL ERREUR(21) 165 : GOTO 9999 166 : ENDIF 167 : ENDIF 168 : C 169 : NBNN=MELEME.NUM(/1) 170 : NBELEM=MELEME.NUM(/2) 171 : C 172 : DO IELEM=1,NBELEM,1 173 : DO IVOI=1,NBNN,1 174 : NGV=MELEME.NUM(IVOI,IELEM) 175 : IF(IVOI .EQ. 1)THEN 176 : NLF=MLEGRA.LECT(NGV) 177 : C write(*,*) 'NGF=',ngv 178 : IF(NLF.EQ.0)THEN 179 : WRITE (IOIMP,*) 'MCHAML of coefficients???' 180 : C 21 2 181 : C Données incompatibles 181 : CALL ERREUR(21) 182 : GOTO 9999 183 : ENDIF 184 : NLV=0 185 : NLL1=MLELI1.LECT(NGV) 186 : NLL2=MLELI2.LECT(NGV) 187 : ELSE 188 : NLV=MLECEN.LECT(NGV) 189 : NLL1=MLELI1.LECT(NGV) 190 : NLL2=MLELI2.LECT(NGV) 191 : ENDIF 192 : C write(*,*) 'NGV=',ngv 193 : IF((NLL1*NLL2) .NE. 0)THEN 194 : WRITE(IOIMP,*) 'Boundary conditions.' 195 : C 21 2 196 : C Données incompatibles 196 : CALL ERREUR(21) 197 : GOTO 9999 198 : ENDIF 199 : C 200 : DO ICOM = 1, NCOM, 1 201 : IF(NLV.NE.0)THEN 202 : VAL=MPOCEN.VPOCHA(NLV,ICOM) 203 : ELSEIF(NLL1.NE.0)THEN 204 : VAL=MPOLI1.VPOCHA(NLL1,ICOM) 205 : ELSEIF(NLL2.NE.0)THEN 206 : NLNO=MLEGRA.LECT(NGV) 207 : I2=(ICOM-1)*IDIM+1 208 : VAL=(MPOLI2.VPOCHA(NLL2,I2)*MPONOR.VPOCHA(NLNO,1))+ 209 : & (MPOLI2.VPOCHA(NLL2,I2+1)*MPONOR.VPOCHA(NLNO,2)) 210 : IF(IDIM .EQ. 3) VAL=VAL+ 211 : & (MPOLI2.VPOCHA(NLL2,I2+2)*MPONOR.VPOCHA(NLNO,3)) 212 : ELSEIF(IVOI .EQ. 1)THEN 213 : VAL=0.0D0 214 : C They can be all equal to 0 just at the first 215 : C iteration (internal FACE point not belonging to BC) 216 : C We chack that the MELVAL are 0 217 : C 218 : IF((MELVA1.VELCHE(IVOI,IELEM) .NE. 0) .OR. 219 : & (MELVA2.VELCHE(IVOI,IELEM) .NE. 0))THEN 220 : WRITE(IOIMP,*) 'Boundary conditions' 221 : C 21 2 222 : C Données incompatibles 222 : CALL ERREUR(21) 223 : GOTO 9999 224 : ELSEIF(IDIM .EQ.3)THEN 225 : IF(MELVA3.VELCHE(IVOI,IELEM) .NE. 0)THEN 226 : WRITE(IOIMP,*) 'Boundary conditions' 227 : C 21 2 228 : C Données incompatibles 228 : CALL ERREUR(21) 229 : GOTO 9999 230 : ENDIF 231 : ENDIF 232 : ELSE 233 : WRITE(IOIMP,*) 'Boundary conditions' 234 : C 21 2 235 : C Données incompatibles 235 : CALL ERREUR(21) 236 : GOTO 9999 237 : ENDIF 238 : C write(*,*) 'VAL =',VAL 239 : I2=(ICOM-1)*IDIM+1 240 : MPOGRA.VPOCHA(NLF,I2)=MPOGRA.VPOCHA(NLF,I2)+ 241 : & (MELVA1.VELCHE(IVOI,IELEM)*VAL) 242 : MPOGRA.VPOCHA(NLF,I2+1)=MPOGRA.VPOCHA(NLF,I2+1)+ 243 : & (MELVA2.VELCHE(IVOI,IELEM)*VAL) 244 : IF(IDIM.EQ.3) 245 : & MPOGRA.VPOCHA(NLF,I2+2)=MPOGRA.VPOCHA(NLF,I2+2)+ 246 : & (MELVA3.VELCHE(IVOI,IELEM)*VAL) 247 : ENDDO 248 : ENDDO 249 : ENDDO 250 : SEGDES MELEME 251 : SEGDES MCHAM1 252 : SEGDES MELVA1 253 : SEGDES MELVA2 254 : IF(IDIM.EQ.3) SEGDES MELVA3 255 : ENDDO 256 : C 257 : SEGDES MCHELM 258 : IF(MPOLI1 .NE. 0) SEGDES MPOLI1 259 : SEGSUP MLELI1 260 : IF(MPOLI2 .NE. 0) SEGDES MPOLI2 261 : SEGSUP MLELI2 262 : SEGDES MPOGRA 263 : SEGDES MPOCEN 264 : SEGSUP MLECEN 265 : SEGSUP MLEGRA 266 : SEGDES MPONOR 267 : C 268 : 9999 RETURN 269 : END 270 : 271 : 272 : 273 : 274 : 275 : 276 :
© Cast3M 2003 - All rights reserved.
Disclaimer