h3d_fld_strain.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	h3d_fld_strain (elbuf_tab, x, ixs, jhbe, mlwi, ilay, kcvt, ior_tsh, icstr, nptr, npts, nel, f_exp, evar)

Function/Subroutine Documentation

h3d_fld_strain()

subroutine h3d_fld_strain	(	type (elbuf_struct_), target	elbuf_tab,
		intent(in)	x,
		integer, dimension(nixs,numels), intent(in)	ixs,
		integer, intent(in)	jhbe,
		integer, intent(in)	mlwi,
		integer, intent(in)	ilay,
		integer, intent(in)	kcvt,
		integer, intent(in)	ior_tsh,
		integer, intent(in)	icstr,
		integer, intent(in)	nptr,
		integer, intent(in)	npts,
		integer, intent(in)	nel,
		intent(in)	f_exp,
		intent(out)	evar )

Definition at line 34 of file h3d_fld_strain.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod    
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER , INTENT(IN) :: JHBE,ILAY,MLWI,KCVT,IOR_TSH,
     .                        NPTR,NPTS,ICSTR,NEL 
      INTEGER ,DIMENSION(NIXS,NUMELS), INTENT(IN) ::  IXS
      my_real , INTENT(IN) ::  f_exp
      my_real ,DIMENSION(3,MVSIZ), INTENT(OUT) ::  evar
      my_real ,DIMENSION(3,NUMNOD), INTENT(IN) ::  x
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C----------------------------------------------- 
      my_real
     .   dir(mvsiz,2),dirb(mvsiz,2)
      INTEGER I,I1,II,J,IR,IS,IT,IL,JJ(4)
 
      TYPE(G_BUFEL_)  ,POINTER :: GBUF     
      TYPE(L_BUFEL_)  ,POINTER :: LBUF     
C----------------------------------------------- 
       evar(1:3,1:nel) = zero
       it = 1
       ir = 0
       is = 0
       DO i=1,4
         jj(i) = nel*(i-1)
       ENDDO
        gbuf => elbuf_tab%GBUF
        IF (jhbe==15) THEN
           ir = 1
           is = 1
           lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
            IF (mlwi == 12 .OR. mlwi == 14) THEN
              DO i=1,nel               
               evar(1:2,i) = lbuf%EPE(jj(1:2) + i)       
               evar(3,i)   = half*lbuf%EPE(jj(4) + i)
              ENDDO                   
            ELSEIF (mlwi /= 49 ) THEN                 
              DO i=1,nel               
               evar(1:2,i) = lbuf%STRA(jj(1:2) + i)       
               evar(3,i)   = half*lbuf%STRA(jj(4) + i)
              ENDDO                   
            END IF               
C------      
        ELSE ! 14,16
          IF (mlwi == 12 .OR. mlwi == 14) THEN
            DO ir=1,nptr
              DO is=1,npts
                 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)         
                 DO i=1,nel               
                  evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)       
                  evar(3,i)   = evar(3,i)+half*lbuf%EPE(jj(4) + i)
                 ENDDO                   
              END DO 
            END DO 
          ELSEIF (mlwi /= 49 ) THEN                 
            DO ir=1,nptr
              DO is=1,npts
                 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)         
                 DO i=1,nel               
                  evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)       
                  evar(3,i)   = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
                 ENDDO                   
              ENDDO 
            END DO 
          END IF               
        END IF               
        evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
C------         
        IF (kcvt==2) THEN
           IF(ior_tsh==1)THEN
             DO i=1,nel
              dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
             ENDDO
           ELSEIF(ior_tsh==2)THEN
             IF(jhbe==14)THEN
              ir = 1
              is = 1
             END IF
             lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)         
             DO i=1,nel
              dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
             ENDDO
           END IF
           CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
           CALL roto_sig2d(1,nel,evar,dirb)
        END IF !(KCVT==2) THEN
C
      RETURN