xyznor_crk.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "scr14_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	xyznor_crk (icrk, xnorm, nfnod_crkxfemg)

Function/Subroutine Documentation

xyznor_crk()

subroutine xyznor_crk	(	integer	icrk,
			xnorm,
		integer	nfnod_crkxfemg )

Definition at line 33 of file xyznor_crk.F.

C-----------------------------------------------
      USE crackxfem_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      "com01_c.inc"
#include      "scr14_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  ICRK
C     REAL
      my_real
     .   xnorm(3,*) 
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I,INORM(3),K,P,IXNN,ND,ARSZ,EMPL,NFNOD_CRKXFEMG
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: INORMAR
C     REAL
      my_real
     .   s3000,s
C=======================================================================
      s3000 = three1000
      ixnn = s3000
      IF (fmt_ani == 4) ixnn=0
C
      IF (nspmd == 1) THEN
        arsz = crknod(icrk)%CRKNUMNODS
        ALLOCATE(inormar(3,arsz))
        DO nd=1,arsz
C          EMPL = ND
C          S = SQRT(XNORM(1,ND)**2 + XNORM(2,ND)**2 + XNORM(3,ND)**2)
          s = zero
          IF(s /= zero)THEN
C           S = S3000 / S
c           INORMAR(1,EMPL) = XNORM(1,I) * S
c           INORMAR(2,EMPL) = XNORM(2,I) * S
c           INORMAR(3,EMPL) = XNORM(3,I) * S
          ELSE
           inormar(1,nd) = 0
           inormar(2,nd) = 0
           inormar(3,nd) = ixnn
          END IF
        END DO
        CALL write_s_c(inormar,3*arsz)
        DEALLOCATE(inormar)
      ELSE
         IF (ispmd==0) THEN
           CALL spmd_wrt_crk_xyznor(icrk,xnorm,nfnod_crkxfemg)
         ELSE
           CALL spmd_wrt_crk_xyznor(icrk,xnorm,1)
         ENDIF
      END IF
C-----------------------------------------------
      RETURN