s8eselecsht.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s8eselecsht (nptr, npts, nptt, nnpt, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, bxx, byy, bzz, bxy, byz, bxz, i_sh, offg, nel, ismstr)

Function/Subroutine Documentation

s8eselecsht()

subroutine s8eselecsht	(	integer	nptr,
		integer	npts,
		integer	nptt,
		integer	nnpt,
			mfxx,
			mfxy,
			mfxz,
			mfyx,
			mfyy,
			mfyz,
			mfzx,
			mfzy,
			mfzz,
			bxx,
			byy,
			bzz,
			bxy,
			byz,
			bxz,
		integer	i_sh,
			offg,
		integer, intent(in)	nel,
		integer, intent(in)	ismstr )

Definition at line 28 of file s8eselecsht.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER NPTR,NPTS,NPTT,NNPT ,I_SH
C     REAL
      my_real
     .  mfxx(mvsiz,nnpt),mfxy(mvsiz,nnpt),mfxz(mvsiz,nnpt),
     .  mfyx(mvsiz,nnpt),mfyy(mvsiz,nnpt),mfyz(mvsiz,nnpt),
     .  mfzx(mvsiz,nnpt),mfzy(mvsiz,nnpt),mfzz(mvsiz,nnpt),
     .  bxx(mvsiz,nnpt),byy(mvsiz,nnpt),bzz(mvsiz,nnpt),
     .  bxy(mvsiz,nnpt),bxz(mvsiz,nnpt),byz(mvsiz,nnpt),offg(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J ,IR,IS,IT,IP
      my_real
     .  b0xy(mvsiz,2),b0xz(mvsiz,2),b0yz(mvsiz,2),
     .  b0yx(mvsiz,2),b0zx(mvsiz,2),b0zy(mvsiz,2)
C------------
       IF (ismstr/=11) THEN      
         DO ip = 1,nnpt
           DO i=1,nel
C ----[B]=[MF+1][MF+1]^t -1 
            IF (ismstr==12.AND.offg(i) >one) cycle 
            bxx(i,ip)=mfxx(i,ip)*(two+mfxx(i,ip))+
     .                mfxy(i,ip)*mfxy(i,ip)+mfxz(i,ip)*mfxz(i,ip) 
            byy(i,ip)=mfyy(i,ip)*(two+mfyy(i,ip))+
     .                mfyx(i,ip)*mfyx(i,ip)+mfyz(i,ip)*mfyz(i,ip)
            bzz(i,ip)=mfzz(i,ip)*(two+mfzz(i,ip))+
     .                mfzx(i,ip)*mfzx(i,ip)+mfzy(i,ip)*mfzy(i,ip)
            bxy(i,ip)=mfxy(i,ip)+mfyx(i,ip)+mfxx(i,ip)*mfyx(i,ip)+
     .                mfxy(i,ip)*mfyy(i,ip)+mfxz(i,ip)*mfyz(i,ip)
            bxz(i,ip)=mfxz(i,ip)+mfzx(i,ip)+mfxx(i,ip)*mfzx(i,ip)+
     .                mfxy(i,ip)*mfzy(i,ip)+mfxz(i,ip)*mfzz(i,ip)
            byz(i,ip)=mfzy(i,ip)+mfyz(i,ip)+mfzx(i,ip)*mfyx(i,ip)+
     .                mfzy(i,ip)*mfyy(i,ip)+mfzz(i,ip)*mfyz(i,ip)  
           ENDDO
         END DO !IP = 1
       END IF !(ISMSTR/=11) THEN               
C
        DO ir = 1,2
          b0xy(1:nel,ir) = zero
          b0xz(1:nel,ir) = zero
          b0yz(1:nel,ir) = zero
        END DO !IR = 1,2
C
      IF (ismstr==11) THEN                           
        DO ir = 1,2
          b0yx(1:nel,ir) = zero
          b0zx(1:nel,ir) = zero
          b0zy(1:nel,ir) = zero
        END DO !IR = 1,2
       DO ir=1,nptr
        DO is=1,npts
        DO it=1,nptt
C-----------
         ip = ir + ( (is-1) + (it-1)*npts )*nptr
C
C------ moyen in 3 directions
         DO i=1,nel
           b0xy(i,ir) = b0xy(i,ir)+mfxy(i,ip)
           b0xz(i,it) = b0xz(i,it)+mfxz(i,ip)
           b0yz(i,is) = b0yz(i,is)+mfyz(i,ip)
           b0yx(i,ir) = b0yx(i,ir)+mfyx(i,ip)
           b0zx(i,it) = b0zx(i,it)+mfzx(i,ip)
           b0zy(i,is) = b0zy(i,is)+mfzy(i,ip)
         END DO
        ENDDO    !  IT=1,NPTT
        ENDDO     !  IS=1,NPTS
       ENDDO      !  IR=1,NPTR
C       
       DO ir = 1,2
         DO i=1,nel
           b0xy(i,ir) = b0xy(i,ir)*fourth
           b0xz(i,ir) = b0xz(i,ir)*fourth
           b0yz(i,ir) = b0yz(i,ir)*fourth
           b0yx(i,ir) = b0yx(i,ir)*fourth
           b0zx(i,ir) = b0zx(i,ir)*fourth
           b0zy(i,ir) = b0zy(i,ir)*fourth
         END DO
       END DO !IR = 1,2
C---------takes the selective mean values-----
       DO ir=1,nptr
        DO is=1,npts
        DO it=1,nptt
C-----------
         ip = ir + ( (is-1) + (it-1)*npts )*nptr
C
         DO i=1,nel
           mfxy(i,ip) = b0xy(i,ir)
           mfxz(i,ip) = b0xz(i,it)
           mfyz(i,ip) = b0yz(i,is)
           mfyx(i,ip) = b0yx(i,ir)
           mfzx(i,ip) = b0zx(i,it)
           mfzy(i,ip) = b0zy(i,is)
         END DO
        ENDDO    !  IT=1,NPTT
        ENDDO     !  IS=1,NPTS
       ENDDO      !  IR=1,NPTR
      ELSE                                     
       DO ir=1,nptr
        DO is=1,npts
        DO it=1,nptt
C-----------
         ip = ir + ( (is-1) + (it-1)*npts )*nptr
C
C------ moyen in 3 directions
         DO i=1,nel
           IF (ismstr==12.AND.offg(i) >one) cycle 
           b0xy(i,ir) = b0xy(i,ir)+bxy(i,ip)
           b0xz(i,it) = b0xz(i,it)+bxz(i,ip)
           b0yz(i,is) = b0yz(i,is)+byz(i,ip)
         END DO
        ENDDO    !  IT=1,NPTT
        ENDDO     !  IS=1,NPTS
       ENDDO      !  IR=1,NPTR
C       
       DO ir = 1,2
         DO i=1,nel
           IF (ismstr==12.AND.offg(i) >one) cycle 
           b0xy(i,ir) = b0xy(i,ir)*fourth
           b0xz(i,ir) = b0xz(i,ir)*fourth
           b0yz(i,ir) = b0yz(i,ir)*fourth
         END DO
       END DO !IR = 1,2
C---------takes the selective mean values-----
       DO ir=1,nptr
        DO is=1,npts
        DO it=1,nptt
C-----------
         ip = ir + ( (is-1) + (it-1)*npts )*nptr
C
         DO i=1,nel
           IF (ismstr==12.AND.offg(i) >one) cycle 
           bxy(i,ip) = b0xy(i,ir)
           bxz(i,ip) = b0xz(i,it)
           byz(i,ip) = b0yz(i,is)
         END DO
        ENDDO    !  IT=1,NPTT
        ENDDO     !  IS=1,NPTS
       ENDDO      !  IR=1,NPTR
      END IF !(ISMSTR==11) THEN  
C       
      RETURN