h3d_dxyz_rwall_update.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/.
!||====================================================================
!||    h3d_dxyz_rwall_update    ../engine/source/output/h3d/h3d_build_fortran/h3d_dxyz_rwall_update.F
!||--- called by ------------------------------------------------------
!||    genh3d                   ../engine/source/output/h3d/h3d_results/genh3d.F
!||--- calls      -----------------------------------------------------
!||    spmd_h3d_getmsr_update   ../engine/source/output/h3d/spmd/spmd_h3d_getmsr_update.F
!||====================================================================
      SUBROUTINE h3d_dxyz_rwall_update (NSTRF,RWBUF,NPRW  ,DISP     ,XMIN ,
     2                     YMIN ,ZMIN  ,XMAX ,YMAX  , ZMAX,
     3                      FR_SEC,FR_WALL,WEIGHT,ITAB,
     4                      XWL ,YWL , ZWL, 
     .  RWALL_V1, RWALL_V2, RWALL_V3, RWALL_V4, RWALL_V5, RWALL_V6 )
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"
#include      "task_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSTRF(*),NPRW(*),ITAB(*)
      my_real
     .  RWBUF(NRWLP,*),DISP(3,*),XMIN ,YMIN ,ZMIN  ,XMAX ,YMAX, ZMAX
      my_real
     .  xwl(*), ywl(*), zwl(*), rwall_v1(*), rwall_v2(*), rwall_v3(*),
     .  rwall_v4(*), rwall_v5(*), rwall_v6(*)
      integer
     .   fr_sec(nspmd+1,*),fr_wall(nspmd+2,*),weight(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER J, I, K, K0, K1, N, NSEG, N1, N2, N3, N4,MSR, ITYP
      my_real
     .   XX1, YY1, ZZ1, XX2, YY2, ZZ2, XX3, YY3, ZZ3,
     .   XX4, YY4, ZZ4, D13, XXC, YYC, ZZC, AL4,
     .   pmain,loc_proc, v1, v2, v3, vv1, vv2,
     .   vv3, r, xn,yn,zn,d,dx,dy,dz, vv
 
      my_real
     .   xsec(3,3,nsect)
      REAL R4,SBUF(3*NSECT)
CC-----------------------------------------------
      loc_proc=ispmd+1
C
C
      k=1
      DO n=1,nrwall
        n2=n +nrwall
        n3=n2+nrwall
        n4=n3+nrwall
        msr = nprw(n3)
        IF (nspmd == 1) THEN
          IF(msr==0)THEN
            xwl(n)= zero
            ywl(n)= zero
            zwl(n)= zero
          ELSE
C verifier que ce noeud est sur proc0 !
            xwl(n)=disp(1,msr)
            ywl(n)=disp(2,msr)
            zwl(n)=disp(3,msr)
          ENDIF
        ELSE
          CALL spmd_h3d_getmsr_update(fr_wall(1,n),disp,msr,xwl(n),ywl(n),zwl(n),rwbuf(1,n))
        END IF
        IF (ispmd==0) THEN
          ityp= nprw(n4)
          IF(ityp==4)THEN
           xwl(n) = xwl(n)
           ywl(n) = ywl(n)
           zwl(n) = zwl(n)
          ENDIF
          k=k+nprw(n)
          IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
        END IF
      ENDDO
C
      k=1
      DO n=1,nrwall
        n2=n +nrwall
        n3=n2+nrwall
        n4=n3+nrwall
        ityp= nprw(n4)
 
        IF(iabs(ityp)==1)THEN
C
          IF (ispmd==0) THEN
c
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
c
        ELSEIF(ityp==2)THEN
C
          IF (ispmd==0) THEN
c
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
        ELSEIF(ityp==3)THEN
c
          IF (ispmd==0) THEN
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
        ELSEIF(ityp==4)THEN
          IF (ispmd==0) THEN
C
            rwall_v1(n) = zero
            rwall_v2(n) = zero
            rwall_v3(n) = zero
            rwall_v4(n) = zero
            rwall_v5(n) = zero
            rwall_v6(n) = zero
          ENDIF
 
        ENDIF
        k=k+nprw(n)
        IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
      ENDDO
C
      RETURN
      END