lecfvbag.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	lecfvbag (nfvmesh, monvol, volmon, x)

Function/Subroutine Documentation

lecfvbag()

subroutine lecfvbag	(	integer	nfvmesh,
		integer, dimension(*)	monvol,
			volmon,
			x )

Definition at line 33 of file lecfvbag.F.

C-----------------------------------------------
C   M o d u l e s 
C-----------------------------------------------
      USE fvbag_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      "com04_c.inc"
#include      "param_c.inc"
#include      "units_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NFVMESH, MONVOL(*)
      my_real
     .        volmon(*), x(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, ID, NBX, NBY, K1, K2, KIBJET, KIBHOL, KIBALE, KK1, N,
     .        ITYP, NN, KI1, J, JJ, NSTEP, IV(10), IFVI, NBZ, IFV
      my_real
     .        vx3, vy3, vz3, vx1, vy1, vz1, dx0, dy0, dz0, lx, ly, norm,
     .        vvx3, vvy3, vvz3, norm2, ss, vvx1, vvy1, vvz1, vvx2,
     .        vvy2, vvz2, lxmax, lymax, xx, yy, zz, xl, yl, x0, y0, z0,
     .        lz, lzmax, zl, rbid
      my_real
     .       , DIMENSION(:,:), ALLOCATABLE :: xxx
C
      DO i=1,nfvmesh
         READ(iin,'(I10)') ifvi
         IF (ifvi==1) THEN
            READ(iin,'(2i10)') ID, NSTEP
            IF (NSTEP==0) NSTEP=20
            READ(IIN,'(3f20.0)') VX3, VY3, VZ3
            READ(IIN,'(3f20.0)') VX1, VY1, VZ1
            READ(IIN,'(3f20.0)') DX0, DY0, DZ0
            READ(IIN,'(3f20.0)') LX, LY, LZ
            READ(IIN,'(3i10)') NBX, NBY, NBZ
C
            K1=1
            K2=1+NIMV*NVOLU
            KIBJET=K2+LICBAG
            KIBHOL=KIBJET+LIBAGJET
            KIBALE=KIBHOL+LIBAGHOL
            KK1=1
            DO N=1,NVOLU
               IF (MONVOL(K1)==ID) THEN
                  ITYP=MONVOL(K1-1+2)
                  IF (ITYP/=6) THEN
                     WRITE(IOUT,'(a33,i8,a38)') 
     . ' /fvmbag/remesh : mon. volume id ',ID,' is not of TYPE fvmbag'//
     . ' - it is ignored'
                     GOTO 100
                  ENDIF
C
                  NORM=SQRT(VX3**2+VY3**2+VZ3**2)
                  IF (NORM==ZERO) THEN
                     VX3=VOLMON(KK1-1+35)
                     VY3=VOLMON(KK1-1+36)
                     VZ3=VOLMON(KK1-1+37)
                     NORM=SQRT(VX3**2+VY3**2+VZ3**2)
                  ENDIF
                  VVX3=VX3/NORM
                  VVY3=VY3/NORM
                  VVZ3=VZ3/NORM
                  NORM2=VX1**2+VY1**2+VZ1**2
                  IF (NORM2==ZERO) THEN
                     VX1=VOLMON(KK1-1+38)
                     VY1=VOLMON(KK1-1+39)
                     VZ1=VOLMON(KK1-1+40)
                  ENDIF
                  X0=VOLMON(KK1-1+41)+DX0
                  Y0=VOLMON(KK1-1+42)+DY0
                  Z0=VOLMON(KK1-1+43)+DZ0
                  IF (LX==ZERO) LX=VOLMON(KK1-1+44)
                  IF (LY==ZERO) LY=VOLMON(KK1-1+45)
                  IF (LZ==ZERO) LZ=VOLMON(KK1-1+53)
                  IF (NBX==0) NBX=MONVOL(K1-1+54)
                  IF (NBY==0) NBY=MONVOL(K1-1+55)
                  IF (NBZ==0) NBZ=MONVOL(K1-1+65)
C Verifications
                  SS=VX1*VVX3+VY1*VVY3+VZ1*VVZ3
                  VVX1=VX1-SS*VVX3
                  VVY1=VY1-SS*VVY3
                  VVZ1=VZ1-SS*VVZ3
                  NORM=SQRT(VVX1**2+VVY1**2+VVZ1**2)
                  IF (NORM==ZERO) THEN
                     WRITE(ISTDO,'(a)') 
     .                       ' ** error in fvmbag meshing DATA '
                     WRITE(IOUT,'(a)') 
     .                       ' ** error in fvmbag meshing DATA '
                     WRITE(IOUT,'(a14,i8)') '    monvol id ',ID
                     WRITE(IOUT,'(a)') 
     .                    '    new cut directions are colinear'
                     CALL ARRET(2)
                  ENDIF
                  VVX1=VVX1/NORM
                  VVY1=VVY1/NORM
                  VVZ1=VVZ1/NORM
                  VVX2=VVY3*VVZ1-VVZ3*VVY1
                  VVY2=VVZ3*VVX1-VVX3*VVZ1
                  VVZ2=VVX3*VVY1-VVY3*VVX1
C
                  LXMAX=ZERO
                  LYMAX=ZERO
                  LZMAX=ZERO
                  NN=MONVOL(K1-1+32)
                  KI1=KIBALE+MONVOL(K1-1+31)
C
                  IFV=MONVOL(K1-1+45)
                  ALLOCATE(XXX(3,NN))
                  CALL SPMD_FVB_GATH(IFV, X, XXX, RBID, RBID,
     .                               1  )
                  IF (ISPMD==FVSPMD(IFV)%PMAIN-1) THEN
                     DO J=1,NN
                        XX=XXX(1,J)
                        YY=XXX(2,J)
                        ZZ=XXX(3,J)
                        XL=(XX-X0)*VVX1+(YY-Y0)*VVY1+(ZZ-Z0)*VVZ1
                        YL=(XX-X0)*VVX2+(YY-Y0)*VVY2+(ZZ-Z0)*VVZ2
                        ZL=(XX-X0)*VVX3+(YY-Y0)*VVY3+(ZZ-Z0)*VVZ3
                        LXMAX=MAX(LXMAX,ABS(XL))
                        LYMAX=MAX(LYMAX,ABS(YL))
                        LZMAX=MAX(LZMAX,ABS(ZL))
                     ENDDO
                  ENDIF
                  DEALLOCATE(XXX)
C
                  IF (LXMAX>LX) THEN
                     WRITE(IOUT,'(a14,i8,a9)') 
     .                        ' ** monvol id ',ID,' (fvmbag)'
                     WRITE(iout,'(A)') '    IN LOCAL FRAME DIRECTION 1'
                     WRITE(iout,'(A18,G11.4,A33,G11.4,G11.4)') 
     .    '    GIVEN LENGTH ',lx,
     .    ' IS SMALLER THAN BOUNDING LENGTH ',lxmax
                     lx=lxmax*onep01
                     WRITE(iout,'(A20,G11.4)') '    IT IS RESET TO ',lx
                  ENDIF
                  IF (lymax>ly) THEN
                     WRITE(iout,'(A14,I8,A9)') 
     .                        ' ** MONVOL ID ',id,' (FVMBAG)'
                     WRITE(iout,'(A)') '    IN LOCAL FRAME DIRECTION 2'
                     WRITE(iout,'(A18,G11.4,A33,G11.4,G11.4)') 
     .    '    GIVEN LENGTH ',ly,
     .    ' IS SMALLER THAN BOUNDING LENGTH ',lymax
                     ly=lymax*onep01
                     WRITE(iout,'(A20,G11.4)') '    IT IS RESET TO ',ly
                  ENDIF
C On autorise le decoupage horizontal d'une bande du maillage uniquement
C                  IF (LZMAX>LZ) THEN
C                     WRITE(IOUT,'(A14,I8,A9)') 
C     .                        ' ** MONVOL ID ',ID,' (ALEBAG)'
C                     WRITE(IOUT,'(A)') '    IN LOCAL FRAME DIRECTION 3'
C                     WRITE(IOUT,'(A18,G11.4,A33,G11.4,G11.4)') 
C     .    '    GIVEN LENGTH ',LZ,
C     .    ' IS SMALLER THAN BOUNDING LENGTH ',LZMAX
C                     LZ=LZMAX*ONEP01
C                     WRITE(IOUT,'(A20,G11.4)') '    IT IS RESET TO ',LZ
C                  ENDIF
C
                  volmon(kk1-1+35)=vx3
                  volmon(kk1-1+36)=vy3
                  volmon(kk1-1+37)=vz3
                  volmon(kk1-1+38)=vx1
                  volmon(kk1-1+39)=vy1
                  volmon(kk1-1+40)=vz1
                  volmon(kk1-1+41)=x0
                  volmon(kk1-1+42)=y0
                  volmon(kk1-1+43)=z0
                  volmon(kk1-1+44)=lx
                  volmon(kk1-1+45)=ly
                  volmon(kk1-1+53)=lz
                  monvol(k1-1+54)=nbx
                  monvol(k1-1+55)=nby
                  monvol(k1-1+65)=nbz
C
                  monvol(k1-1+56)=1
                  monvol(k1-1+58)=nstep
               ENDIF
               k1=k1+nimv
               kk1=kk1+nrvolu
            ENDDO
         ENDIF
  100 ENDDO
C
      RETURN