char_weak.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\char_weak.f
00002 !
00047                      SUBROUTINE CHAR_WEAK
00048 !                    ********************
00049 !
00050      &(FTILD,FTILD_WEAK,SURFAC,IKLE,NPOIN,NELEM,NELMAX,NG,NGAUSS,
00051      & MESH,T1,T2,TB,AGGLO,IELM,NPLAN,Z,CV1,AM1,SLV,UNSV,LISTIN,SOLV)
00052 !
00053 !***********************************************************************
00054 ! BIEF   V6P3                                   21/08/2010
00055 !***********************************************************************
00056 !
00057 !
00058 !
00059 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00060 !| AM1            |-->| BIEF_OBJ WORK MATRIX
00061 !| CV1            |-->| BIEF_OBJ WORK ARRAY
00062 !| FTILD          |-->| BLOCK OF RESULTS
00063 !| FTILD_WEAK     |-->| BLOCK OF RESULTS FOR ADVECTED GAUSS POINTS
00064 !| IELM           |-->| TYPE OF ELEMENT
00065 !| IKLE           |-->| CONNECTIVITY TABLE FOR ALL POINTS
00066 !| NELEM          |-->| NOMBRE D'ELEMENTS
00067 !| NELMAX         |-->| NOMBRE MAXIMUM D'ELEMENTS
00068 !| NG             |-->| TOTAL NUMBER OF GAUSS POINTS IN THE MESH
00069 !| NGAUSS         |-->| NUMBER OF GAUSS POINTS PER ELEMENT
00070 !| NPOIN          |-->| NUMBER OF POINTS IN THE MESH
00071 !| SOLV           |-->| IF YES, SOLVE THE LINEAR SYSTEM
00072 !| SURFAC         |-->| AREA OF ELEMENTS
00073 !| Z              |-->| ELEVATIONS OF POINTS IN THE MESH.
00074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00075 !
00076       USE BIEF
00077 !
00078       IMPLICIT NONE
00079       INTEGER LNG,LU
00080       COMMON/INFO/LNG,LU
00081 !
00082 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00083 !
00084       INTEGER, INTENT(IN)             :: NELEM,NELMAX,NPOIN,NG,IELM
00085       INTEGER, INTENT(IN)             :: NPLAN,NGAUSS
00086 !                                        HERE IKLE2 AND NELMAX2
00087       INTEGER, INTENT(IN)             :: IKLE(NELMAX,3)
00088       LOGICAL, INTENT(IN)             :: LISTIN,SOLV
00089       DOUBLE PRECISION, INTENT(IN)    :: SURFAC(NELMAX),AGGLO,Z(*)
00090       TYPE(BIEF_OBJ), INTENT(IN)      :: FTILD_WEAK,UNSV
00091       TYPE(BIEF_OBJ), INTENT(INOUT)   :: FTILD,T1,T2,TB,CV1,AM1
00092       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00093       TYPE(SLVCFG), INTENT(INOUT)     :: SLV
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER IELEM,I1,I2,I3,I4,I5,I6,I,IG,IPLAN
00098       DOUBLE PRECISION TIERS,A,B,C,D,H1,H2,H3,A1,A2,A3
00099       DOUBLE PRECISION WEIGH1,WEIGH2,WEIGH3
00100 !
00101       TIERS=1.D0/3.D0
00102 !
00103 !-----------------------------------------------------------------------
00104 !
00105 !     INITIALISATION
00106 !
00107       CALL CPSTVC(FTILD,CV1)
00108 !
00109       DO I=1,NPOIN*NPLAN
00110         CV1%R(I)=0.D0
00111       ENDDO
00112 !
00113       IF(NG.NE.NELEM*NGAUSS.AND.IELM.EQ.11) THEN
00114         IF(LNG.EQ.1) THEN
00115           WRITE(LU,*) 'CHAR_WEAK : MAUVAIS NOMBRE DE POINTS'
00116         ENDIF
00117         IF(LNG.EQ.2) THEN
00118           WRITE(LU,*) 'CHAR_WEAK: BAD NUMBER OF POINTS'
00119         ENDIF
00120         WRITE(LU,*) 'NG=',NG,' NELEM=',NELEM,' NGAUSS=',NGAUSS
00121         CALL PLANTE(1)
00122         STOP
00123       ELSEIF(NG.NE.NELEM*(NPLAN-1)*NGAUSS.AND.IELM.EQ.41) THEN
00124         IF(LNG.EQ.1) THEN
00125           WRITE(LU,*) 'CHAR_WEAK : MAUVAIS NOMBRE DE POINTS'
00126         ENDIF
00127         IF(LNG.EQ.2) THEN
00128           WRITE(LU,*) 'CHAR_WEAK: BAD NUMBER OF POINTS'
00129         ENDIF
00130         WRITE(LU,*) 'NG=',NG,' NELEM=',NELEM,' NGAUSS=',NGAUSS
00131         WRITE(LU,*) 'NPLAN=',NPLAN
00132         CALL PLANTE(1)
00133         STOP
00134       ENDIF
00135 !
00136       IF(NGAUSS.EQ.1.AND.IELM.EQ.11) THEN
00137 !
00138 !       ASSEMBLING (3 BASES PER ELEMENT)
00139 !       HERE THE VALUE OF THE BASIS IS 1/3 FOR ALL 3 OF THEM
00140 !       AND THE WEIGHS ARE ALL SURFAC
00141 !
00142         DO IELEM=1,NELEM
00143           I1=IKLE(IELEM,1)
00144           I2=IKLE(IELEM,2)
00145           I3=IKLE(IELEM,3)
00146           CV1%R(I1)=CV1%R(I1)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IELEM)
00147           CV1%R(I2)=CV1%R(I2)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IELEM)
00148           CV1%R(I3)=CV1%R(I3)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IELEM)
00149         ENDDO
00150 !
00151       ELSEIF(NGAUSS.EQ.3.AND.IELM.EQ.11) THEN
00152 !
00153 !       ASSEMBLING (3 BASES PER ELEMENT)
00154 !       HERE THE WEIGHS ARE ALL SURFAC/3
00155 !       THE VALUES IF THE TEST FUNCTIONS AT GAUSS POINTS ARE ON THE RIGHT
00156 !
00157         IG=0
00158         DO IELEM=1,NELEM
00159           I1=IKLE(IELEM,1)
00160           I2=IKLE(IELEM,2)
00161           I3=IKLE(IELEM,3)
00162 !         POINT DE GAUSS 1
00163           IG=IG+1
00164           CV1%R(I1)=
00165      &    CV1%R(I1)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*2.D0/3.D0
00166           CV1%R(I2)=
00167      &    CV1%R(I2)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*1.D0/6.D0
00168           CV1%R(I3)=
00169      &    CV1%R(I3)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*1.D0/6.D0
00170 !         POINT DE GAUSS 2
00171           IG=IG+1
00172           CV1%R(I1)=
00173      &    CV1%R(I1)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*1.D0/6.D0
00174           CV1%R(I2)=
00175      &    CV1%R(I2)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*2.D0/3.D0
00176           CV1%R(I3)=
00177      &    CV1%R(I3)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*1.D0/6.D0
00178 !         POINT DE GAUSS 3
00179           IG=IG+1
00180           CV1%R(I1)=
00181      &    CV1%R(I1)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*1.D0/6.D0
00182           CV1%R(I2)=
00183      &    CV1%R(I2)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*1.D0/6.D0
00184           CV1%R(I3)=
00185      &    CV1%R(I3)+SURFAC(IELEM)*TIERS*FTILD_WEAK%R(IG)*2.D0/3.D0
00186         ENDDO
00187 !
00188       ELSEIF(NGAUSS.EQ.4.AND.IELM.EQ.11) THEN
00189 !
00190 !       ASSEMBLING (3 BASES PER ELEMENT)
00191 !       THE WEIGHS ARE:
00192 !       -27*SURFAC/48 FOR POINT 1
00193 !        25*SURFAC/48 FOR POINT 2,3 AND 4
00194 !
00195         IG=0
00196         DO IELEM=1,NELEM
00197           I1=IKLE(IELEM,1)
00198           I2=IKLE(IELEM,2)
00199           I3=IKLE(IELEM,3)
00200 !         MONOTONICITY IF FORMULA APPROXIMATE ?
00201           WEIGH1=-27.D0*SURFAC(IELEM)/48.D0
00202           WEIGH2= 25.D0*SURFAC(IELEM)/48.D0
00203 !         POINT DE GAUSS 1
00204           IG=IG+1
00205           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*1.D0/3.D0
00206           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*1.D0/3.D0
00207           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*1.D0/3.D0
00208 !         POINT DE GAUSS 2
00209           IG=IG+1
00210           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*3.D0/5.D0
00211           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*1.D0/5.D0
00212           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*1.D0/5.D0
00213 !         POINT DE GAUSS 3
00214           IG=IG+1
00215           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*1.D0/5.D0
00216           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*3.D0/5.D0
00217           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*1.D0/5.D0
00218 !         POINT DE GAUSS 4
00219           IG=IG+1
00220           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*1.D0/5.D0
00221           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*1.D0/5.D0
00222           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*3.D0/5.D0
00223         ENDDO
00224 !
00225       ELSEIF(NGAUSS.EQ.6.AND.IELM.EQ.11) THEN
00226 !
00227 !       ASSEMBLING (3 BASES PER ELEMENT)
00228 !       THE WEIGHS ARE:
00229 !       WEIGH1 FOR POINT 1,2,3
00230 !       WEIGH2 FOR POINT 4,5,6
00231 !
00232         IG=0
00233         A=0.445948490915965D0
00234         B=0.091576213509771D0
00235         DO IELEM=1,NELEM
00236           I1=IKLE(IELEM,1)
00237           I2=IKLE(IELEM,2)
00238           I3=IKLE(IELEM,3)
00239           WEIGH1=SURFAC(IELEM)*2.D0*0.111690794839005D0
00240           WEIGH2=SURFAC(IELEM)*2.D0*0.054975871827661D0
00241 !         POINT DE GAUSS 1
00242           IG=IG+1
00243           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*(1.D0-A-A)
00244           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*A
00245           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*A
00246 !         POINT DE GAUSS 2
00247           IG=IG+1
00248           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*A
00249           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*(1.D0-A-A)
00250           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*A
00251 !         POINT DE GAUSS 3
00252           IG=IG+1
00253           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*A
00254           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*A
00255           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*(1.D0-A-A)
00256 !         POINT DE GAUSS 4
00257           IG=IG+1
00258           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-B-B)
00259           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*B
00260           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*B
00261 !         POINT DE GAUSS 5
00262           IG=IG+1
00263           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*B
00264           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-B-B)
00265           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*B
00266 !         POINT DE GAUSS 6
00267           IG=IG+1
00268           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*B
00269           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*B
00270           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-B-B)
00271         ENDDO
00272 !
00273       ELSEIF(NGAUSS.EQ.7.AND.IELM.EQ.11) THEN
00274 !
00275 !       ASSEMBLING (3 BASES PER ELEMENT)
00276 !       THE WEIGHS ARE:
00277 !       WEIGH1 FOR POINT 1,2,3
00278 !       WEIGH2 FOR POINT 4,5,6
00279 !
00280         IG=0
00281         A=(6.D0+SQRT(15.D0))/21.D0
00282         B=4.D0/7.D0-A
00283         A1=9.D0/80.D0
00284         A2=(155.D0+SQRT(15.D0))/2400.D0
00285         A3=31.D0/240.D0-A2
00286         DO IELEM=1,NELEM
00287           I1=IKLE(IELEM,1)
00288           I2=IKLE(IELEM,2)
00289           I3=IKLE(IELEM,3)
00290           WEIGH1=SURFAC(IELEM)*2.D0*A1
00291           WEIGH2=SURFAC(IELEM)*2.D0*A2
00292           WEIGH3=SURFAC(IELEM)*2.D0*A3
00293 !         POINT DE GAUSS 1
00294           IG=IG+1
00295           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*TIERS
00296           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*TIERS
00297           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*TIERS
00298 !         POINT DE GAUSS 2
00299           IG=IG+1
00300           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-A-A)
00301           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*A
00302           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*A
00303 !         POINT DE GAUSS 3
00304           IG=IG+1
00305           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*A
00306           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-A-A)
00307           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*A
00308 !         POINT DE GAUSS 4
00309           IG=IG+1
00310           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*A
00311           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*A
00312           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-A-A)
00313 !         POINT DE GAUSS 5
00314           IG=IG+1
00315           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-B-B)
00316           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*B
00317           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*B
00318 !         POINT DE GAUSS 6
00319           IG=IG+1
00320           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*B
00321           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-B-B)
00322           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*B
00323 !         POINT DE GAUSS 7
00324           IG=IG+1
00325           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*B
00326           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*B
00327           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-B-B)
00328         ENDDO
00329 !
00330       ELSEIF(NGAUSS.EQ.12.AND.IELM.EQ.11) THEN
00331 !
00332         IG=0
00333         A=0.063089014491502D0
00334         B=0.249286745170910D0
00335         C=0.310352451033785D0
00336         D=0.053145049844816D0
00337         A1=0.025422453185103D0
00338         A2=0.058393137863189D0
00339         A3=0.041425537809187D0
00340         A3=(1.D0-6.D0*A1-6.D0*A2)/12.D0
00341         DO IELEM=1,NELEM
00342           I1=IKLE(IELEM,1)
00343           I2=IKLE(IELEM,2)
00344           I3=IKLE(IELEM,3)
00345           WEIGH1=SURFAC(IELEM)*2.D0*A1
00346           WEIGH2=SURFAC(IELEM)*2.D0*A2
00347           WEIGH3=SURFAC(IELEM)*2.D0*A3
00348 !         POINT DE GAUSS 1
00349           IG=IG+1
00350           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*(1.D0-A-A)
00351           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*A
00352           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*A
00353 !         POINT DE GAUSS 2
00354           IG=IG+1
00355           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*A
00356           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*(1.D0-A-A)
00357           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*A
00358 !         POINT DE GAUSS 3
00359           IG=IG+1
00360           CV1%R(I1)=CV1%R(I1)+WEIGH1*FTILD_WEAK%R(IG)*A
00361           CV1%R(I2)=CV1%R(I2)+WEIGH1*FTILD_WEAK%R(IG)*A
00362           CV1%R(I3)=CV1%R(I3)+WEIGH1*FTILD_WEAK%R(IG)*(1.D0-A-A)
00363 !         POINT DE GAUSS 4
00364           IG=IG+1
00365           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-B-B)
00366           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*B
00367           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*B
00368 !         POINT DE GAUSS 5
00369           IG=IG+1
00370           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*B
00371           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-B-B)
00372           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*B
00373 !         POINT DE GAUSS 6
00374           IG=IG+1
00375           CV1%R(I1)=CV1%R(I1)+WEIGH2*FTILD_WEAK%R(IG)*B
00376           CV1%R(I2)=CV1%R(I2)+WEIGH2*FTILD_WEAK%R(IG)*B
00377           CV1%R(I3)=CV1%R(I3)+WEIGH2*FTILD_WEAK%R(IG)*(1.D0-B-B)
00378 !         POINT DE GAUSS 7
00379           IG=IG+1
00380           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C-D)
00381           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*C
00382           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*D
00383 !         POINT DE GAUSS 8
00384           IG=IG+1
00385           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C-D)
00386           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*D
00387           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*C
00388 !         POINT DE GAUSS 9
00389           IG=IG+1
00390           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*D
00391           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C-D)
00392           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*C
00393 !         POINT DE GAUSS 10
00394           IG=IG+1
00395           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*C
00396           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C-D)
00397           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*D
00398 !         POINT DE GAUSS 11
00399           IG=IG+1
00400           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*D
00401           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*C
00402           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C-D)
00403 !         POINT DE GAUSS 12
00404           IG=IG+1
00405           CV1%R(I1)=CV1%R(I1)+WEIGH3*FTILD_WEAK%R(IG)*C
00406           CV1%R(I2)=CV1%R(I2)+WEIGH3*FTILD_WEAK%R(IG)*D
00407           CV1%R(I3)=CV1%R(I3)+WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C-D)
00408         ENDDO
00409 !
00410       ELSEIF(NGAUSS.EQ.6.AND.IELM.EQ.41) THEN
00411 !
00412 !       ASSEMBLING (3 BASES PER ELEMENT)
00413 !       THE WEIGHS ARE:
00414 !       WEIGH1 FOR POINT 1,2,3
00415 !       WEIGH2 FOR POINT 4,5,6
00416 !
00417         A=1.D0/6.D0
00418         B=2.D0/3.D0
00419         C=0.5D0*(1.D0-1.D0/SQRT(3.D0))
00420         D=0.5D0*(1.D0+1.D0/SQRT(3.D0))
00421 !
00422         IG=0
00423         DO IPLAN=1,NPLAN-1
00424         DO IELEM=1,NELEM
00425           I1=IKLE(IELEM,1)+(IPLAN-1)*NPOIN
00426           I2=IKLE(IELEM,2)+(IPLAN-1)*NPOIN
00427           I3=IKLE(IELEM,3)+(IPLAN-1)*NPOIN
00428           I4=I1+NPOIN
00429           I5=I2+NPOIN
00430           I6=I3+NPOIN
00431           H1=Z(I4)-Z(I1)
00432           H2=Z(I5)-Z(I2)
00433           H3=Z(I6)-Z(I3)
00434           WEIGH1=SURFAC(IELEM)*(H1*(1.D0-A-A)+H2*A+H3*A)/6.D0
00435           WEIGH2=SURFAC(IELEM)*(H1*(1.D0-B-A)+H2*B+H3*A)/6.D0
00436           WEIGH3=SURFAC(IELEM)*(H1*(1.D0-A-B)+H2*A+H3*B)/6.D0
00437 !         POINT DE GAUSS 1
00438           IG=IG+1
00439           CV1%R(I1)=CV1%R(I1)
00440      &             +WEIGH1*FTILD_WEAK%R(IG)*(1.D0-C)*(1.D0-A-A)
00441           CV1%R(I2)=CV1%R(I2)
00442      &             +WEIGH1*FTILD_WEAK%R(IG)*(1.D0-C)* A
00443           CV1%R(I3)=CV1%R(I3)
00444      &             +WEIGH1*FTILD_WEAK%R(IG)*(1.D0-C)* A
00445           CV1%R(I4)=CV1%R(I4)
00446      &             +WEIGH1*FTILD_WEAK%R(IG)*      C *(1.D0-A-A)
00447           CV1%R(I5)=CV1%R(I5)
00448      &             +WEIGH1*FTILD_WEAK%R(IG)*      C * A
00449           CV1%R(I6)=CV1%R(I6)
00450      &             +WEIGH1*FTILD_WEAK%R(IG)*      C * A
00451 !         POINT DE GAUSS 2
00452           IG=IG+1
00453           CV1%R(I1)=CV1%R(I1)
00454      &             +WEIGH2*FTILD_WEAK%R(IG)*(1.D0-C)*(1.D0-B-A)
00455           CV1%R(I2)=CV1%R(I2)
00456      &             +WEIGH2*FTILD_WEAK%R(IG)*(1.D0-C)* B
00457           CV1%R(I3)=CV1%R(I3)
00458      &             +WEIGH2*FTILD_WEAK%R(IG)*(1.D0-C)* A
00459           CV1%R(I4)=CV1%R(I4)
00460      &             +WEIGH2*FTILD_WEAK%R(IG)*      C *(1.D0-B-A)
00461           CV1%R(I5)=CV1%R(I5)
00462      &             +WEIGH2*FTILD_WEAK%R(IG)*      C * B
00463           CV1%R(I6)=CV1%R(I6)
00464      &             +WEIGH2*FTILD_WEAK%R(IG)*      C * A
00465 !         POINT DE GAUSS 3
00466           IG=IG+1
00467           CV1%R(I1)=CV1%R(I1)
00468      &             +WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C)*(1.D0-A-B)
00469           CV1%R(I2)=CV1%R(I2)
00470      &             +WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C)* A
00471           CV1%R(I3)=CV1%R(I3)
00472      &             +WEIGH3*FTILD_WEAK%R(IG)*(1.D0-C)* B
00473           CV1%R(I4)=CV1%R(I4)
00474      &             +WEIGH3*FTILD_WEAK%R(IG)*      C *(1.D0-A-B)
00475           CV1%R(I5)=CV1%R(I5)
00476      &             +WEIGH3*FTILD_WEAK%R(IG)*      C * A
00477           CV1%R(I6)=CV1%R(I6)
00478      &             +WEIGH3*FTILD_WEAK%R(IG)*      C * B
00479 !         POINT DE GAUSS 4
00480           IG=IG+1
00481           CV1%R(I1)=CV1%R(I1)
00482      &             +WEIGH1*FTILD_WEAK%R(IG)*(1.D0-D)*(1.D0-A-A)
00483           CV1%R(I2)=CV1%R(I2)
00484      &             +WEIGH1*FTILD_WEAK%R(IG)*(1.D0-D)* A
00485           CV1%R(I3)=CV1%R(I3)
00486      &             +WEIGH1*FTILD_WEAK%R(IG)*(1.D0-D)* A
00487           CV1%R(I4)=CV1%R(I4)
00488      &             +WEIGH1*FTILD_WEAK%R(IG)*      D *(1.D0-A-A)
00489           CV1%R(I5)=CV1%R(I5)
00490      &             +WEIGH1*FTILD_WEAK%R(IG)*      D * A
00491           CV1%R(I6)=CV1%R(I6)
00492      &             +WEIGH1*FTILD_WEAK%R(IG)*      D * A
00493 !         POINT DE GAUSS 5
00494           IG=IG+1
00495           CV1%R(I1)=CV1%R(I1)
00496      &             +WEIGH2*FTILD_WEAK%R(IG)*(1.D0-D)*(1.D0-B-A)
00497           CV1%R(I2)=CV1%R(I2)
00498      &             +WEIGH2*FTILD_WEAK%R(IG)*(1.D0-D)* B
00499           CV1%R(I3)=CV1%R(I3)
00500      &             +WEIGH2*FTILD_WEAK%R(IG)*(1.D0-D)* A
00501           CV1%R(I4)=CV1%R(I4)
00502      &             +WEIGH2*FTILD_WEAK%R(IG)*      D *(1.D0-B-A)
00503           CV1%R(I5)=CV1%R(I5)
00504      &             +WEIGH2*FTILD_WEAK%R(IG)*      D * B
00505           CV1%R(I6)=CV1%R(I6)
00506      &             +WEIGH2*FTILD_WEAK%R(IG)*      D * A
00507 !         POINT DE GAUSS 6
00508           IG=IG+1
00509           CV1%R(I1)=CV1%R(I1)
00510      &             +WEIGH3*FTILD_WEAK%R(IG)*(1.D0-D)*(1.D0-A-B)
00511           CV1%R(I2)=CV1%R(I2)
00512      &             +WEIGH3*FTILD_WEAK%R(IG)*(1.D0-D)* A
00513           CV1%R(I3)=CV1%R(I3)
00514      &             +WEIGH3*FTILD_WEAK%R(IG)*(1.D0-D)* B
00515           CV1%R(I4)=CV1%R(I4)
00516      &             +WEIGH3*FTILD_WEAK%R(IG)*      D *(1.D0-A-B)
00517           CV1%R(I5)=CV1%R(I5)
00518      &             +WEIGH3*FTILD_WEAK%R(IG)*      D * A
00519           CV1%R(I6)=CV1%R(I6)
00520      &             +WEIGH3*FTILD_WEAK%R(IG)*      D * B
00521         ENDDO
00522         ENDDO
00523 !
00524       ELSE
00525 !
00526         IF(LNG.EQ.1) WRITE(LU,10) NGAUSS
00527         IF(LNG.EQ.2) WRITE(LU,11) NGAUSS
00528 10      FORMAT(1X,'CHAR_WEAK : OPTION NON PREVUE :'    ,I6)
00529 11      FORMAT(1X,'CHAR_WEAK: OPTION NOT IMPLEMENTED:',I6)
00530         CALL PLANTE(1)
00531         STOP
00532 !
00533       ENDIF
00534 !
00535 !-----------------------------------------------------------------------
00536 !
00537       IF(SOLV) THEN
00538 !
00539 !       MASS-MATRIX
00540 !
00541         CALL MATRIX(AM1,'M=N     ','MATMAS          ',IELM,IELM,
00542      &              1.D0,FTILD,FTILD,FTILD,FTILD,FTILD,FTILD,
00543      &              MESH,.FALSE.,FTILD)
00544 !
00545 !       PARTIALLY LUMPING THE MASS-MATRIX
00546 !
00547         CALL LUMP(T2,AM1,MESH,AGGLO)
00548         CALL OM( 'M=CN    ' , AM1 , AM1 , FTILD  , 1.D0-AGGLO , MESH )
00549         CALL OM( 'M=M+D   ' , AM1 , AM1 , T2     , 0.D0       , MESH )
00550 !
00551 !       INITIAL GUESS (AS IF MATRIX LUMPED...)
00552 !
00553         CALL OS('X=Y     ',X=FTILD,Y=CV1)
00554         IF(NCSIZE.GT.1) CALL PARCOM(FTILD,2,MESH)
00555         CALL OS('X=XY    ',X=FTILD,Y=UNSV)
00556 !
00557 !       SOLUTION OF THE SYSTEM (WITHOUT BOUNDARY CONDITIONS...)
00558 !
00559         CALL SOLVE(FTILD,AM1,CV1,TB,SLV,LISTIN,MESH,MESH%M)
00560 !
00561       ENDIF
00562 !
00563 !-----------------------------------------------------------------------
00564 !
00565       RETURN
00566       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0