cfield_imp.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_imp         ../engine/source/loads/general/load_centri/cfield_imp.F
!||--- called by ------------------------------------------------------
!||    imp_chkm           ../engine/source/implicit/imp_solv.F
!||    imp_solv           ../engine/source/implicit/imp_solv.F
!||--- calls      -----------------------------------------------------
!||    finter             ../engine/source/tools/curve/finter.F
!||    relfram_m1         ../engine/source/tools/skew/relfram_m1.F
!||--- uses       -----------------------------------------------------
!||    finter_mixed_mod   ../engine/source/tools/finter_mixed.F90
!||    python_funct_mod   ../common_source/modules/python_mod.F90
!||    sensor_mod         ../common_source/modules/sensor_mod.F90
!||====================================================================
      SUBROUTINE cfield_imp(ICFIELD  ,FAC   ,NPC   ,TF    ,A ,
     2                  V     ,X     ,XFRAME  ,MS,WFEXTT,
     3                  NSENSOR,SENSOR_TAB,WEIGHT,IFRAME,
     4                  IB,ITASK,
     5                  NRBYAC,IRBYAC,NPBY  ,RBY,ISKN, PYTHON  )
C-----------------------------------------------  
C   M o d u l e s
C-----------------------------------------------  
      USE sensor_mod
      USE python_funct_mod
      USE finter_mixed_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      "com08_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: NSENSOR
      TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
      INTEGER NPC(*)
      INTEGER ICFIELD(SIZFIELD,*),IB(*)
      INTEGER WEIGHT(*),ITASK,NRBYAC,IRBYAC(*),NPBY(NNPBY,*),IFRAME(LISKN,*),ISKN(LISKN,*)
      my_real fac(lfacload,*), tf(*), a(3,*), v(3,*), ms(*),x(3,*), xframe(nxframe,*),wfextt, rby(nrby,*)
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
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
      my_real NX, NY, NZ, AXI, A0, AA, VV, FX, FY, FZ, AX,  TS,
     .        GAMA, MA, VROT, X0, Y0, Z0, X1, Y1, Z1, X2, Y2, Z2, VROTM1
      my_real DIST(3),AREL(3),VN1FRAM(3),AN1FRAM(3),DW(3)
      my_real finter 
C-----------------------------------------------
      EXTERNAL finter
      DATA iun/1/
C-----------------------------------------------
C
      DO nl=1,nloadc
      nn=icfield(1,nl)
      idir=icfield(2,nl)
      ifunc=icfield(3,nl)
      iad=icfield(4,nl)
C-------only for Itask=0 first-----
      iadf = iad+itask*nn
      iadl = iad-1+(itask+1)*nn
C
      ifra=icfield(7,nl)
      n1fram = 0
      IF(ifra /= 0) n1fram = iframe(1,ifra)
      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)
      IF (ifra == 0) THEN
c If no frame defined rotation /X axis of global reference system 
        x0 = 0
        y0 = 0
        z0 = 0
        x2 = 1
        y2 = 0
        z2 = 0
      ENDIF
C 
      isens=icfield(6,nl)
      IF(isens==0)THEN
          ts=tt
      ELSE
          ts = tt-sensor_tab(isens)%TSTART
          IF(ts<0.0)RETURN
      ENDIF
C
      vrot = fac(1,nl)*finter_mixed(python,nfunct,ifunc,ts*fac(2,nl),npc,tf)
      vrotm1=vrot
      IF (dt2 > zero .AND. iflag == 2) vrotm1 = fac(1,nl)*finter_mixed(python,nfunct,ifunc,(ts-dt2)*fac(2,nl),npc,tf)
      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)
      ELSEIF(idir == 6) THEN
        x2 = xframe(7,ifra+1)
        y2 = xframe(8,ifra+1)
        z2 = xframe(9,ifra+1)
      ENDIF
C
#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
           IF (dt2 > 0 .AND. iflag == 2) THEN
             dw(1) = ((vrot-vrotm1)/dt2)*x2
             dw(2) = ((vrot-vrotm1)/dt2)*y2
             dw(3) = ((vrot-vrotm1)/dt2)*z2
             arel(1) = dist(1)*vrot*vrot + dist(2) * dw(3) - dist(3) * dw(2)
             arel(2) = dist(2)*vrot*vrot + dist(3) * dw(1) - dist(1) * dw(3)
             arel(3) = dist(3)*vrot*vrot + dist(1) * dw(2) - dist(2) * dw(1)
           ELSE
             arel(1) = dist(1)*vrot*vrot
             arel(2) = dist(2)*vrot*vrot
             arel(3) = dist(3)*vrot*vrot
           ENDIF
           IF (imovfram == 1)
     .            CALL relfram_m1(x(1,n1)  ,v(1,n1), arel , xframe, vn1fram , an1fram   )
             a(1,n1)=a(1,n1)+arel(1)*ms(n1)
             a(2,n1)=a(2,n1)+arel(2)*ms(n1)
             a(3,n1)=a(3,n1)+arel(3)*ms(n1)
            IF(ib(j)>0)
     .        wfextt=wfextt + half*ms(n1)*x1*x1*(vrot-vrotm1)*(vrot-vrotm1)
         ENDDO
C
      ENDDO
C
      RETURN
      END