cfield.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    cfield_1              ../engine/source/loads/general/load_centri/cfield.F
!||--- called by ------------------------------------------------------
!||    resol                 ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    finter                ../engine/source/tools/curve/finter.F
!||    my_barrier            ../engine/source/system/machine.f
!||    relfram_m1            ../engine/source/tools/skew/relfram_m1.F
!||--- uses       -----------------------------------------------------
!||    python_funct_mod      ../common_source/modules/python_mod.F90
!||    sensor_mod            ../common_source/modules/sensor_mod.F90
!||====================================================================
      SUBROUTINE cfield_1(PYTHON, ICFIELD  ,FAC   ,NPC   ,TF    ,A ,
     2                  V     ,X     ,XFRAME  ,MS,SENSOR_TAB,
     3                  WEIGHT,IB,ITASK,IFRAME,NSENSOR,WFEXT)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
      USE sensor_mod
      USE python_funct_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "task_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(python_), INTENT(INOUT) :: PYTHON
      INTEGER ,INTENT(IN) :: NSENSOR
      INTEGER NPC(*)
      INTEGER ICFIELD(SIZFIELD,*),IB(*),IFRAME(LISKN,*)
      INTEGER WEIGHT(*),ITASK
      my_real fac(lfacload,*), tf(*), a(3,*), v(3,*), ms(*),x(3,*), xframe(nxframe,*)
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
      DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NL, N1, IFRA, N2, IFUNC, K1, K2, K3, ISENS,K,NN,IAD, J, PROC, IADF, IADL,IDIR,IFLAG,N1FRAM,IUN,JJ,IMOVFRAM
      INTEGER :: IS_TABULATED
      my_real nx, ny, nz, axi, a0, aa, vv, fx, fy, fz, ax, dydx, ts,
     .        gama, ma, vrot, x0, y0, z0, x1, y1, z1, x2, y2, z2, dwdt,
     .        wfextt,vmx,vmy,vmz,vrot2
      my_real dist(3),arel(3),vn1fram(3),an1fram(3),dw(3)
      my_real finter
C-----------------------------------------------
      EXTERNAL finter
      DATA iun/1/
C-----------------------------------------------
 
      wfextt = zero
      DO nl=1,nloadc
      nn   = icfield(1,nl)
      idir = icfield(2,nl)
      ifunc= icfield(3,nl)
      iad  = icfield(4,nl)
      iadf = iad+itask*nn/nthread
      iadl = iad-1+(itask+1)*nn/nthread
      ifra = icfield(7,nl)
      n1fram = 0
      IF(ifra /= 0) n1fram = iframe(1,ifra+1)
      imovfram = 0
      IF (n1fram /= 0) THEN
        vn1fram(1) = v(1,n1fram)
        vn1fram(2) = v(2,n1fram)
        vn1fram(3) = v(3,n1fram)
        an1fram(1) = a(1,n1fram)
        an1fram(2) = a(2,n1fram)
        an1fram(3) = a(3,n1fram)
        imovfram = 1
      ELSE
        vn1fram(1) = zero
        vn1fram(2) = zero
        vn1fram(3) = zero
        an1fram(1) = zero
        an1fram(2) = zero
        an1fram(3) = zero
      ENDIF
      iflag=icfield(8,nl)
      isens = icfield(6,nl)
      IF(isens==0)THEN
          ts=tt
      ELSE
          ts = tt-sensor_tab(isens)%TSTART
          IF(ts<zero)cycle
      ENDIF
 
      is_tabulated = npc(2*nfunct+ifunc+1)
      IF(is_tabulated >= 0) THEN
        vrot  = fac(1,nl)*finter(ifunc,ts*fac(2,nl),npc,tf,dydx)
      ELSE 
        is_tabulated = -is_tabulated
        CALL python_call_funct1d(python, is_tabulated,ts*fac(2,nl), vrot)
        vrot = vrot * fac(1,nl)
      ENDIF
 
      vrot2 = vrot*vrot
      x0 = xframe(10,ifra+1)
      y0 = xframe(11,ifra+1)
      z0 = xframe(12,ifra+1)
      IF(idir == 4) THEN
        x2 = xframe(1,ifra+1)
        y2 = xframe(2,ifra+1)
        z2 = xframe(3,ifra+1)
      ELSEIF(idir == 5) THEN
        x2 = xframe(4,ifra+1)
        y2 = xframe(5,ifra+1)
        z2 = xframe(6,ifra+1)
      ELSE !IF(IDIR == 6) THEN
        x2 = xframe(7,ifra+1)
        y2 = xframe(8,ifra+1)
        z2 = xframe(9,ifra+1)
      ENDIF
 
       IF (iflag == 2 .AND. imovfram == 1) THEN
         dwdt  = fac(1,nl)*dydx
#include "vectorize.inc"
         DO j=iadf,iadl
           n1=iabs(ib(j))
           x1 = x(1,n1)-x0
           y1 = x(2,n1)-y0
           z1 = x(3,n1)-z0
           dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
           dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
           dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2 
           dw(1) = dwdt*x2
           dw(2) = dwdt*y2
           dw(3) = dwdt*z2
           arel(1) = dist(1)*vrot2 + dw(2) * dist(3) - dw(3) * dist(2)
           arel(2) = dist(2)*vrot2 + dw(3) * dist(1) - dw(1) * dist(3)
           arel(3) = dist(3)*vrot2 + dw(1) * dist(2) - dw(2) * dist(1)
           CALL relfram_m1(x(1,n1)  ,v(1,n1), arel , xframe(1,ifra+1), vn1fram , an1fram   )
           a(1,n1)=a(1,n1)+arel(1)
           a(2,n1)=a(2,n1)+arel(2)
           a(3,n1)=a(3,n1)+arel(3)
           IF(ib(j)>0)THEN
             vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
             vmy=v(2,n1)+half*dt2*a(2,n1)
             vmz=v(3,n1)+half*dt2*a(3,n1) 
             wfextt=wfextt + ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
           END IF
         ENDDO
       ELSEIF(iflag == 2) THEN
         dwdt  = fac(1,nl)*dydx
#include "vectorize.inc"
         DO j=iadf,iadl
           n1=iabs(ib(j))
           x1 = x(1,n1)-x0
           y1 = x(2,n1)-y0
           z1 = x(3,n1)-z0
           dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
           dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
           dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2 
           dw(1) = dwdt*x2
           dw(2) = dwdt*y2
           dw(3) = dwdt*z2
           arel(1) = dist(1)*vrot2 + dw(2) * dist(3) - dw(3) * dist(2)
           arel(2) = dist(2)*vrot2 + dw(3) * dist(1) - dw(1) * dist(3)
           arel(3) = dist(3)*vrot2 + dw(1) * dist(2) - dw(2) * dist(1)
           a(1,n1)=a(1,n1)+arel(1)
           a(2,n1)=a(2,n1)+arel(2)
           a(3,n1)=a(3,n1)+arel(3)
           IF(ib(j)>0)THEN
             vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
             vmy=v(2,n1)+half*dt2*a(2,n1)
             vmz=v(3,n1)+half*dt2*a(3,n1) 
             wfextt=wfextt+ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
           END IF
         ENDDO
       ELSEIF(imovfram == 1) THEN
#include "vectorize.inc"
         DO j=iadf,iadl
           n1=iabs(ib(j))
           x1 = x(1,n1)-x0
           y1 = x(2,n1)-y0
           z1 = x(3,n1)-z0
           dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
           dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
           dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2 
           arel(1) = dist(1)*vrot2
           arel(2) = dist(2)*vrot2
           arel(3) = dist(3)*vrot2
           CALL relfram_m1(x(1,n1)  ,v(1,n1), arel , xframe(1,ifra+1),vn1fram , an1fram   )
           a(1,n1)=a(1,n1)+arel(1)
           a(2,n1)=a(2,n1)+arel(2)
           a(3,n1)=a(3,n1)+arel(3)
           IF(ib(j)>0)THEN
             vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
             vmy=v(2,n1)+half*dt2*a(2,n1)
             vmz=v(3,n1)+half*dt2*a(3,n1) 
             wfextt=wfextt+ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
           END IF
         ENDDO
       ELSE
#include "vectorize.inc"
         DO j=iadf,iadl
           n1=iabs(ib(j))
           x1 = x(1,n1)-x0
           y1 = x(2,n1)-y0
           z1 = x(3,n1)-z0
           dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
           dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
           dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2 
           arel(1) = dist(1)*vrot2
           arel(2) = dist(2)*vrot2
           arel(3) = dist(3)*vrot2
           a(1,n1)=a(1,n1)+arel(1)
           a(2,n1)=a(2,n1)+arel(2)
           a(3,n1)=a(3,n1)+arel(3)
           IF(ib(j)>0)THEN
             vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
             vmy=v(2,n1)+half*dt2*a(2,n1)
             vmz=v(3,n1)+half*dt2*a(3,n1) 
             wfextt=wfextt +ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
           END IF
         ENDDO
       ENDIF
C      /---------------/
       CALL my_barrier
C      /---------------/
      ENDDO
C
!$OMP ATOMIC
      wfext = wfext + wfextt
C
      RETURN
      END