158 lines
4.3 KiB
Fortran
Executable File
158 lines
4.3 KiB
Fortran
Executable File
subroutine chgnorm(ipt1,ipt2,ipt3)
|
|
C
|
|
C#######################################################################
|
|
C
|
|
C PURPOSE -
|
|
C
|
|
C THIS ROUTINE TRANSFORMS POINTS FROM THE LOCAL COORDINATE SYSTEM
|
|
C TO THE CURRENT NORMAL COORDINATE SYSTEM. THE CURRENT ORIGIN AND
|
|
C ROTATION MATRIX ARE USED FOR THE TRANSALTION. BOTH POINTS
|
|
C AND DIRECTION VELOCITIES ARE TRANSFORMED.
|
|
C
|
|
C
|
|
C INPUT ARGUMENTS -
|
|
C
|
|
C ipt1 - FIRST POINT TO TRANSFORM
|
|
C ipt2 - LAST POINT TO TRANSFORM
|
|
C ipt3 - STRIDE
|
|
C
|
|
C
|
|
C OUTPUT ARGUMENTS -
|
|
C
|
|
C NONE
|
|
C
|
|
C
|
|
C CHANGE HISTORY -
|
|
C
|
|
C FO0825AA-89, FO0828AA-89, FO0918AB-89
|
|
C
|
|
C
|
|
C $Log: chgnorm.f,v $
|
|
C Revision 2.00 2007/11/05 19:45:47 spchu
|
|
C Import to CVS
|
|
C
|
|
CPVCS
|
|
CPVCS Rev 1.21 02 Oct 2007 12:40:28 spchu
|
|
CPVCS original version
|
|
C
|
|
C#######################################################################
|
|
C
|
|
implicit none
|
|
C
|
|
include 'chydro.h'
|
|
C
|
|
character*32 cmo, isubname
|
|
C
|
|
C#######################################################################
|
|
pointer (ipxic, xic)
|
|
pointer (ipyic, yic)
|
|
pointer (ipzic, zic)
|
|
real*8 xic(100000),yic(100000),zic(100000)
|
|
C
|
|
real*8 ax,bx,cx,ay,by,cy,az,bz,cz,u1,v1,w1,x1,y1,z1,x0,y0,z0
|
|
integer i2,icmotype,icmolen,ierror_return,index,ier,nmcmoatt,
|
|
* ipt1,ipt2,ipt3,ierr1,ierror,ilen,i1,ityp,icmotyp,
|
|
* i,icscode
|
|
|
|
pointer (ipcmo,xcmo)
|
|
real*8 xcmo(3,1000000)
|
|
character*32 cname,crank,cio,cpers,cinter,clen,ctype
|
|
|
|
C#######################################################################
|
|
C GET THE CURRENT ORIGIN
|
|
C
|
|
x0=origc(1)
|
|
y0=origc(2)
|
|
z0=origc(3)
|
|
C
|
|
C ******************************************************************
|
|
C GET THE CURRENT ROTATION MATRIX
|
|
C
|
|
ax=rotatc(1,1)
|
|
bx=rotatc(1,2)
|
|
cx=rotatc(1,3)
|
|
ay=rotatc(2,1)
|
|
by=rotatc(2,2)
|
|
cy=rotatc(2,3)
|
|
az=rotatc(3,1)
|
|
bz=rotatc(3,2)
|
|
cz=rotatc(3,3)
|
|
C
|
|
C ******************************************************************
|
|
isubname = 'chgnorm'
|
|
ierr1 = 0
|
|
C
|
|
C Get the existing cmo
|
|
C
|
|
call cmo_get_name(cmo,ierror)
|
|
call cmo_get_info('xic',cmo,ipxic,ilen,icmotype,ierror)
|
|
call cmo_get_info('yic',cmo,ipyic,ilen,icmotype,ierror)
|
|
call cmo_get_info('zic',cmo,ipzic,ilen,icmotype,ierror)
|
|
C TRANSPOSE AND ROTATE THE POINTS TO
|
|
C THE LOCAL ORIGIN AND AXIS
|
|
C
|
|
if (ipt3 .lt. 1) ipt3=1
|
|
do 10 i1=ipt1,ipt2,ipt3
|
|
x1=xic(i1)
|
|
y1=yic(i1)
|
|
z1=zic(i1)
|
|
xic(i1)=ax*x1 + ay*y1 + az*z1 + x0
|
|
yic(i1)=bx*x1 + by*y1 + bz*z1 + y0
|
|
zic(i1)=cx*x1 + cy*y1 + cz*z1 + z0
|
|
10 continue
|
|
C
|
|
C look for mesh object attributes that are vectors
|
|
C rotate them
|
|
C
|
|
call cmo_get_info('number_of_attributes',cmo,nmcmoatt,ilen,ityp,
|
|
* icscode)
|
|
do i=1,nmcmoatt
|
|
call cmo_get_attribute_name(cmo,i,cname,ier)
|
|
call cmo_get_attparam(cname,cmo,index,ctype,crank,
|
|
* clen,cinter,cpers,cio,ierror_return)
|
|
if(crank(1:6).eq.'vector') then
|
|
call cmo_get_info(cname,cmo,ipcmo,icmolen,icmotyp,icscode)
|
|
do i1=ipt1,ipt2,ipt3
|
|
u1=xcmo(1,i1)
|
|
v1=xcmo(2,i1)
|
|
w1=xcmo(3,i1)
|
|
xcmo(1,i1)= ax*u1 + ay*v1 + az*w1
|
|
xcmo(2,i1)= bx*u1 + by*v1 + bz*w1
|
|
xcmo(3,i1)= cx*u1 + cy*v1 + cz*w1
|
|
enddo
|
|
endif
|
|
enddo
|
|
C
|
|
C ******************************************************************
|
|
C TRANSPOSE AND ROTATE BOUNDARY DEFINITIONS VELOCITIES TO
|
|
C THE LOCAL ORIGIN AND AXIS
|
|
C
|
|
if (nb .gt. 0) then
|
|
do 30 i1=1,3
|
|
do 20 i2=1,nb
|
|
x1=xbb(i1,i2)
|
|
y1=ybb(i1,i2)
|
|
z1=zbb(i1,i2)
|
|
xbb(i1,i2)=ax*x1 + ay*y1 + az*z1 + x0
|
|
ybb(i1,i2)=bx*x1 + by*y1 + bz*z1 + y0
|
|
zbb(i1,i2)=cx*x1 + cy*y1 + cz*z1 + z0
|
|
u1=ubb(i1,i2)
|
|
v1=vbb(i1,i2)
|
|
w1=wbb(i1,i2)
|
|
ubb(i1,i2)=ax*u1 + ay*v1 + az*w1
|
|
vbb(i1,i2)=bx*u1 + by*v1 + bz*w1
|
|
wbb(i1,i2)=cx*u1 + cy*v1 + cz*w1
|
|
20 continue
|
|
30 continue
|
|
endif
|
|
C
|
|
C
|
|
C ******************************************************************
|
|
C SET UP THE CFT IMMUNE STATEMENT FOR DDT
|
|
C
|
|
goto 9999
|
|
9999 continue
|
|
C
|
|
return
|
|
end
|