rsens_nic.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	rsens_nic (nel, ixr, for, mom, skew, nsensor, sensor_tab)

Function/Subroutine Documentation

rsens_nic()

subroutine rsens_nic	(	integer, intent(in)	nel,
		integer, dimension(nixr,numelr), intent(in)	ixr,
		intent(in)	for,
		intent(in)	mom,
		dimension(lskew,numskw)	skew,
		integer, intent(in)	nsensor,
		type (sensor_str_), dimension(nsensor), intent(inout)	sensor_tab )

Definition at line 30 of file rsens_nic.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE sensor_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      "param_c.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) :: NEL,NSENSOR
      INTEGER ,DIMENSION(NIXR,NUMELR) ,INTENT(IN) :: IXR
      my_real ,DIMENSION(NEL) ,INTENT(IN)  :: for,mom
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(INOUT) :: SENSOR_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I,J,SPRING_ID,ISENS,SPR_SKW,SEN_SKW,IDIR_F,IDIR_M
      my_real :: fz,my,ftens,fcomp,mflex,mext,fgx,fgy,fgz,mgx,mgy,mgz
      my_real ,DIMENSION(3) :: ff,mm
      my_real ,DIMENSION(LSKEW,NUMSKW) :: skew
c-----------------------------------------------------------------------
c     send current normalized forces and moments in the spring to sensor for processing
c=======================================================================
      isens = 0
      DO j = 1,nsensor
        IF (sensor_tab(j)%TYPE == 19) THEN  ! sensor NIC_Nij
          isens = j
          sen_skw   = sensor_tab(isens)%IPARAM(3)
          spr_skw = sensor_tab(isens)%IPARAM(4)
          idir_f = sensor_tab(isens)%IPARAM(5) 
          idir_m = sensor_tab(isens)%IPARAM(6) 
c
          ftens  = sensor_tab(isens)%RPARAM(2) 
          fcomp  = sensor_tab(isens)%RPARAM(3) 
          mflex  = sensor_tab(isens)%RPARAM(4) 
          mext   = sensor_tab(isens)%RPARAM(5) 
          EXIT
        END IF
      END DO
c     we assume there's only one NIC-Nij sensor in the model
      IF (isens > 0) THEN   
        my = zero
        fz = zero
        DO i = 1,nel
          spring_id = ixr(6,i)
          IF (sensor_tab(isens)%IPARAM(1) == spring_id) THEN
            ff(1) = for(i)
            ff(2) = for(i+nel)
            ff(3) = for(i+nel*2)
            mm(1) = mom(i)
            mm(2) = mom(i+nel)
            mm(3) = mom(i+nel*2)
c           rotate to sensor skew if necessary
            IF (sen_skw > 1) THEN
              IF (sen_skw /= spr_skw) THEN
                fgx   = skew(1,spr_skw)*ff(1)+skew(4,spr_skw)*ff(2)+skew(7,spr_skw)*ff(3)
                fgy   = skew(2,spr_skw)*ff(1)+skew(5,spr_skw)*ff(2)+skew(8,spr_skw)*ff(3)
                fgz   = skew(3,spr_skw)*ff(1)+skew(6,spr_skw)*ff(2)+skew(9,spr_skw)*ff(3)
                ff(1) = skew(1,sen_skw)*fgx+skew(2,sen_skw)*fgy+skew(3,sen_skw)*fgz
                ff(2) = skew(4,sen_skw)*fgx+skew(5,sen_skw)*fgy+skew(6,sen_skw)*fgz
                ff(3) = skew(7,sen_skw)*fgx+skew(8,sen_skw)*fgy+skew(9,sen_skw)*fgz
                mgx   = skew(1,spr_skw)*mm(1)+skew(4,spr_skw)*mm(2)+skew(7,spr_skw)*mm(3)
                mgy   = skew(2,spr_skw)*mm(1)+skew(5,spr_skw)*mm(2)+skew(8,spr_skw)*mm(3)
                mgz   = skew(3,spr_skw)*mm(1)+skew(6,spr_skw)*mm(2)+skew(9,spr_skw)*mm(3)
                mm(1) = skew(1,sen_skw)*mgx+skew(2,sen_skw)*mgy+skew(3,sen_skw)*mgz
                mm(2) = skew(4,sen_skw)*mgx+skew(5,sen_skw)*mgy+skew(6,sen_skw)*mgz
                mm(3) = skew(7,sen_skw)*mgx+skew(8,sen_skw)*mgy+skew(9,sen_skw)*mgz
              END IF
              fz = ff(idir_f)
              my = mm(idir_m)
            END IF
c           save normalized FZ and My values
            IF (fz >= zero) THEN
              fz = fz / ftens
            ELSE 
              fz = abs(fz) / fcomp
            END IF
            IF (my >= zero) THEN
              my = my / mflex
            ELSE 
              my = abs(my) / mext
            END IF
            sensor_tab(isens)%VAR(1) = fz
            sensor_tab(isens)%VAR(2) = my
            sensor_tab(isens)%VAR(3) = one ! spmd flag for sensor indicating present domain
            EXIT
          END IF
        END DO
      END IF
c-----------
      RETURN