module mb_data
implicit none
type::blk1
integer(4) ni,nj,nk
integer(4) num_i0,num_idim,num_j0,num_jdim,num_k0,num_kdim
real(8),allocatable,dimension(:,:,:)::x,y,z
integer(4),allocatable,dimension(:,:,:)::ibank
end type blk1

type::bc1
integer(4) key,blk,is,ie,js,je,ks,ke,face,side
character(20) typ,group,nam
integer(4) typ_num
integer(4) bcg
end type bc1

type::if1
integer(4) key,blk1,is,ie,js,je,ks,ke,blk2,pair
integer(4) face,side
end type if1

type::ifp1
integer(4) blk1,is1,ie1,js1,je1,ks1,ke1
integer(4) blk2,is2,ie2,js2,je2,ks2,ke2
integer(4) ii1,jj1,kk1,ss1
integer(4) ii2,jj2,kk2,ss2
integer(4) i1,j1,k1
integer(4) i2,j2,k2
real(8) x1(4),y1(4),z1(4)
real(8) x2(4),y2(4),z2(4)
integer(4) is3,ie3,js3,je3,ks3,ke3
integer(4) jj3,kk3
integer(4) link,dir1,dir2
end type ifp1

end module mb_data




program cfdrc_to_cfl3d
use mb_data
implicit none
namelist/cfdrcfile/file,pfgd,ibc
namelist/nondimension/cref,bref,sref,xmc,ymc,zmc
namelist/flowcondition/xmach,alpha,beta,pinf,tinf
namelist/solvercontrol/i2d,mglevg,irest,ncyc,dtmax,iflagts,fmax,ifullns,cprec,ifds,epsa_r,rkap0,idiag,iflim,ivisc,edvislim,iturbord,nwrest
namelist/output/isurfg,surfg
namelist/bc2002/bc2002name,pratio
namelist/controlsurface/csname
character(20) csname
!integer(4) ncs
character(20) bc2002name
real(8) pratio
character(20) file,pfgd,ibc
character(30) file1,file2
real(8) cref,bref,sref,xmc,ymc,zmc
real(8) xmach,alpha,beta,pinf,tinf
integer(4) i2d,mglevg,irest,ncyc(3),iflagts,ifullns,ifds,idiag,iflim,ivisc,iturbord
real(8) dtmax,fmax,cprec,epsa_r,rkap0,edvislim
real(8) muref,tref,tsut,csut,muinf,cinf,deninf
integer(4) isurfg
character(20) surfg
real(8),parameter::pi=3.141592653589793238d0
real(8) tinf_dr
real(8) reue
integer(4) ialph,ihstry
real(8) dt,cfltau
integer(4) iunst
integer(4) ngrid,nplot3d,nprint,nwrest,ichk,ntstep,ita
type(blk1),allocatable,target,dimension(:)::b
type(blk1),pointer::b1,b2
type(bc1),allocatable,target,dimension(:)::c
type(bc1),pointer::c1,c2
type(if1),allocatable,target,dimension(:)::f
type(if1),pointer::f1,f2
type(ifp1),allocatable,target,dimension(:)::p
type(ifp1),pointer::p1
character(20) ccc,ccc1,ccc2,ccc3
integer(4) num_blk,num_bc,num_if,num_ifp
integer(4) num_bcg
integer(4) i,j,k,ii,jj,kk
integer(4) d(3,3)
real(8) dist1,dist2,dmin
character(20),allocatable::bc_name(:)
integer(4),allocatable::ftyp(:)
integer(4) iflag
integer(4) ncg,iem,iadvance
character(3) iforce
integer(4) ilamlo,ilamhi,jlamlo,jlamhi,klamlo,klamhi
integer(4) inewg,igridc
integer(4) iovrlp
integer(4) ndata
real(8) twratio,cq
integer(4) mseq,mgflag,iconsf,mtt,ngam
integer(4) issc,issr
real(8) epsssc,epsssr
integer(4) nemgl,nitfo
integer(4) mit
integer(4) ninter
integer(4) iptype
integer(4) imovie
integer(4) ncs
integer(4) mglevg_max,mglevg_allow,imgflag,mglevg_allow_1,mglevg_allow_2,mglevg_allow_3
integer(4) nii,njj
integer(4),allocatable::bcg_num(:)
integer(4),allocatable::bcg_pair(:)
integer(4),allocatable::ipatch(:)
integer(4) ipatchflag
integer(4) ioflag,itrace
integer(4) iifit,llmit,iitmax,mmcxie,mmceta,iic0,iiorph
integer(4) iis,iie,jjs,jje


imgflag=0
mglevg_allow=1
mglevg_allow_1=1
mglevg_allow_2=1
mglevg_allow_3=1
mglevg_max=3

ipatchflag=0

open(501,file='cfdrc_to_cfl3d-v1.inp')
open(601,file='cfl3d.inp')
open(602,file='cfl3d.grd',form='unformatted')


read(501,NML=cfdrcfile)

file1=trim(file)//'.'//trim(pfgd)
file2=trim(file)//'.'//trim(ibc)
write(*,*) 'INPUT CFDRC GRID FILES:'
write(*,*) file1,file2
open(502,file=file1)
open(503,file=file2)


cref=1d0
bref=-100d0
sref=-100d0
xmc=0d0
ymc=0d0
zmc=0d0

read(501,NML=nondimension)


if(bref<0d0) then
bref=cref

endif

if(sref<0d0) then
sref=pi*cref**2/4d0
endif
xmach=2d0;alpha=0d0;beta=0d0;pinf=101325d0;tinf=300d0
read(501,NML=flowcondition)
i2d=0;irest=0;ifullns=0;cprec=0d0;ifds=1
epsa_r=0.3d0;rkap0=0.3333d0;idiag=0;iflim=4;ivisc=-5;edvislim=100000d0;iturbord=1
read(501,NML=solvercontrol)
isurfg=0;surfg='none'
read(501,NML=output)
read(501,NML=bc2002)
read(501,NML=controlsurface)

muref=1.716d-5
tref=273.15d0
tsut=110.4d0 !
csut=muref*(tref+tsut)/tref**1.5 !1.458d-6
muinf=csut*tinf**1.5/(tinf+tsut)
cinf=dsqrt(1.4d0*286.9d0*tinf)
deninf=pinf/286.9d0/tinf
reue=deninf*xmach*cinf/muinf/1d6
tinf_dr=tinf*9d0/5d0

ialph=0
ihstry=2

dt=dtmax/fmax
iunst=0
cfltau=5d0

!!!read ibc
read(503,*) ccc
read(503,*) ccc
read(503,*) num_if
if(num_if/=0)then
allocate(f(num_if))
num_ifp=num_if/2
allocate(p(num_ifp))

do i=1,num_if
f1=>f(i)
read(503,*) f1%key,f1%blk1,f1%is,f1%ie,f1%js,f1%je,f1%ks,f1%ke,f1%blk2
f1%pair=-1

if(f1%is==f1%ie) then
f1%face=1
if(f1%is>1)then
f1%side=2
else
f1%side=1
endif
elseif(f1%js==f1%je) then
f1%face=2
if(f1%js>1)then
f1%side=2
else
f1%side=1
endif
elseif(f1%ks==f1%ke) then
f1%face=3
if(f1%ks>1)then
f1%side=2
else
f1%side=1
endif
else
write(*,*) 'IBC interface error!'
stop
endif
enddo
num_blk=f1%blk1 !!!
endif














read(503,*) num_bc
if(num_bc/=0)then
allocate(c(num_bc),ftyp(num_blk))
allocate(bc_name(num_bc))
allocate(bcg_num(num_bc))
allocate(bcg_pair(num_bc))
allocate(ipatch(num_bc))

do i=1,num_blk
ftyp(i)=0
enddo

num_bcg=0

do i=1,num_bc
c1=>c(i)
c1%bcg=0
read(503,*) c1%key,c1%blk,c1%is,c1%ie,c1%js,c1%je,c1%ks,c1%ke,c1%typ,c1%group,c1%nam
if(c1%typ=='Symmetry') then
c1%typ_num=1001
elseif(c1%typ=='Inlet') then
c1%typ_num=1000
elseif(c1%typ=='Outlet') then
c1%typ_num=1002
elseif(c1%typ=='Wall') then
c1%typ_num=2004
ftyp(c1%blk)=1
c1%bcg=1
elseif(c1%typ=='R_wall') then
c1%typ_num=1013 !!! singular
elseif(c1%typ=='Thin_wall') then
c1%typ_num=0 !!! patched interface
else
write(*,*) 'IBC bc error!'
write(*,*) 'Undefined bc type:'
write(*,*) c1%typ
stop
endif


!!! bc2002
if(c1%nam==bc2002name) then
c1%typ_num=2002
endif




if(c1%is==c1%ie) then
c1%face=1
if(c1%is>1)then
c1%side=2
else
c1%side=1
endif
elseif(c1%js==c1%je) then
c1%face=2
if(c1%js>1)then
c1%side=2
else
c1%side=1
endif
elseif(c1%ks==c1%ke) then
c1%face=3
if(c1%ks>1)then
c1%side=2
else
c1%side=1
endif
else
write(*,*) 'IBC bc error!'
stop
endif


iflag=0
if(num_bcg==0) then
bc_name(1)=c1%nam
c1%bcg=1
else

do j=1,num_bcg

if(bc_name(j)==c1%nam) then
iflag=1
c1%bcg=j
endif

enddo

endif

if(iflag/=1) then
num_bcg=num_bcg+1
bc_name(num_bcg)=c1%nam
c1%bcg=num_bcg
endif

enddo



do j=1,num_bcg
bcg_num(j)=0
bcg_pair(j)=0
ipatch(j)=0

do i=1,num_bc
c1=>c(i)
if(c1%bcg==j) then
bcg_num(j)=bcg_num(j)+1
if(c1%typ=='Thin_wall') then
ipatch(j)=1
endif
endif

enddo

if(ipatch(j)==1) then

do k=1,num_bcg

if(k/=j)then

if(bc_name(j)(3:20)==bc_name(k)(3:20)) then
bcg_pair(j)=k
endif

endif

enddo


endif

enddo



ninter=0
do j=1,num_bcg
if(ipatch(j)==1) then

do i=1,num_bc

c1=>c(i)
if(c1%bcg==j) then
ninter=ninter+1

do k=1,num_bc
c2=>c(k)

if(c2%bcg==bcg_pair(j)) then

endif
enddo

endif
enddo


endif
enddo





do j=1,num_bcg
if(ipatch(j)==1) then
ipatchflag=1
endif
enddo













endif

























if(i2d /= 1) then

open(603,file='plot3d.fvbnd')

!!! gen plot3d.fvbnd
write(*,*) 'BC GROUPS:',num_bcg
write(603,*) 'FVBND 1 4'
do i=1,num_bcg
write(*,*) i,bc_name(i)
write(603,*) bc_name(i)
enddo
write(603,*) 'BOUNDARIES'
do i=1,num_bcg
do j=1,num_bc
c1=>c(j)
if(c1%bcg==i)then
write(603,'(8I5,A5)') i,c1%blk,c1%is,c1%ie,c1%js,c1%je,c1%ks,c1%ke,'F 0'
endif
enddo
enddo

write(*,*) '3D case'
write(*,*) 'Generate plot3d.fvbnd'

else

write(*,*) '2D case'

endif






!!!read pfgd!!! gen cfl3d.grd
read(502,*) num_blk
write(602) num_blk !!!cfl3d.grd
allocate(b(num_blk))
do i=1,num_blk
b1=>b(i)
read(502,*) b1%ni,b1%nj,b1%nk
allocate(b1%x(b1%ni,b1%nj,b1%nk),b1%y(b1%ni,b1%nj,b1%nk),b1%z(b1%ni,b1%nj,b1%nk))
allocate(b1%ibank(b1%ni,b1%nj,b1%nk))
b1%num_i0=0
b1%num_idim=0
b1%num_j0=0
b1%num_jdim=0
b1%num_k0=0
b1%num_kdim=0
enddo

write(602) (b(i)%ni,b(i)%nj,b(i)%nk,i=1,num_blk)

do ii=1,num_blk
b1=>b(ii)
read(502,*) (((b1%x(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk),(((b1%y(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk),(((b1%z(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk),(((b1%ibank(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk)
write(602) (((b1%x(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk),(((b1%y(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk),(((b1%z(i,j,k),i=1,b1%ni),j=1,b1%nj),k=1,b1%nk)
enddo
!!!





ncs=0
if(num_bc /= 0) then
do i=1,num_bc
c1=>c(i)
b1=>b(c1%blk)

!!! control surface
if(c1%nam==csname) then
ncs=ncs+1
endif

if(c1%face==1) then

if(c1%side==1) then
b1%num_i0=b1%num_i0+1
else
b1%num_idim=b1%num_idim+1
endif


elseif(c1%face==2) then

if(c1%side==1) then
b1%num_j0=b1%num_j0+1
else
b1%num_jdim=b1%num_jdim+1
endif


else



if(c1%side==1) then
b1%num_k0=b1%num_k0+1
else
b1%num_kdim=b1%num_kdim+1
endif




endif

enddo
endif
!!!
if(num_if /= 0) then
do i=1,num_if
f1=>f(i)
b1=>b(f1%blk1)
!!! control surface
!if(f1%nam==csname) then
!ncs=ncs+1
!endif



if(f1%face==1) then

if(f1%side==1) then
b1%num_i0=b1%num_i0+1
else
b1%num_idim=b1%num_idim+1
endif

elseif(f1%face==2) then

if(f1%side==1) then
b1%num_j0=b1%num_j0+1
else
b1%num_jdim=b1%num_jdim+1
endif


else

if(f1%side==1) then
b1%num_k0=b1%num_k0+1
else
b1%num_kdim=b1%num_kdim+1
endif


endif


enddo
endif


!write(*,*) ncs




!!!
ngrid=-num_blk
nplot3d=num_blk
nprint=0
ichk=0
ntstep=1
ita=-2




!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if(mglevg>mglevg_max)then
mglevg=mglevg_max
!write(*,*) 'Auto change mglevg due to mglevg_max=3!'
endif





if(i2d==0) then !!! MGL 3D


mglevg_allow=1

!mg_block check
if(mglevg /= 1) then
do j=2,mglevg_max
do i=1,num_blk
b1=>b(i)

if(mod(b1%ni-1,2**(j-1))/=0)then
imgflag=1
endif
if(mod(b1%nj-1,2**(j-1))/=0)then
imgflag=1
endif
if(mod(b1%nk-1,2**(j-1))/=0)then
imgflag=1
endif

enddo
if(imgflag/=1)then
mglevg_allow=j
else
imgflag=0
endif
enddo

!write(*,*) 'mg block check, allowable mg level',mglevg_allow


if(mglevg>mglevg_allow)then
mglevg=mglevg_allow
!write(*,*) 'Auto change mglevg due to block dimensions!'
endif

endif


mglevg_allow=1


!mg_bc check
if(num_bc /= 0) then
if(mglevg /= 1) then
do j=2,mglevg_max
do i=1,num_bc
c1=>c(i)
if(c1%face==1) then
nii=c1%je-c1%js+1
njj=c1%ke-c1%ks+1
elseif(c1%face==2) then
nii=c1%ke-c1%ks+1
njj=c1%ie-c1%is+1
else
nii=c1%ie-c1%is+1
njj=c1%je-c1%js+1
endif


if(mod(nii-1,2**(j-1))/=0)then
imgflag=1
endif

if(mod(njj-1,2**(j-1))/=0)then
imgflag=1
endif


enddo

if(imgflag/=1)then
mglevg_allow=j
else
imgflag=0
endif

enddo

!write(*,*) 'mg bc check, allowable mg level',mglevg_allow


if(mglevg>mglevg_allow)then
mglevg=mglevg_allow
!write(*,*) 'Auto change mglevg due to bc dimensions!'
endif
endif
endif

mglevg_allow=1

if(num_if /= 0) then
if(mglevg /= 1) then
do j=2,mglevg_max
do i=1,num_if
f1=>f(i)
if(f1%face==1) then
nii=f1%je-f1%js+1
njj=f1%ke-f1%ks+1
elseif(f1%face==2) then
nii=f1%ke-f1%ks+1
njj=f1%ie-f1%is+1
else
nii=f1%ie-f1%is+1
njj=f1%je-f1%js+1
endif
!if(mod(nii-1,(j-1)*2)/=0)then
if(mod(nii-1,2**(j-1))/=0)then
imgflag=1
endif
!if(mod(njj-1,(j-1)*2)/=0)then
if(mod(njj-1,2**(j-1))/=0)then
imgflag=1
endif
!if(nii<5+(j-2)*4) then
!imgflag=1
!endif
!if(njj<5+(j-2)*4) then
!imgflag=1
!endif
enddo
if(imgflag/=1)then
mglevg_allow=j
else
imgflag=0
endif
enddo
!write(*,*) 'mg interface check, allowable mg level',mglevg_allow
if(mglevg>mglevg_allow)then
mglevg=mglevg_allow
!write(*,*) 'Auto change mglevg due to interface dimensions!'
endif
endif
endif

else !!! 2D case




mglevg_allow=1


!mg_block check
if(mglevg /= 1) then
do j=2,mglevg_max
do i=1,num_blk
b1=>b(i)
if(mod(b1%nj-1,2**(j-1))/=0)then
imgflag=1
endif
if(mod(b1%nk-1,2**(j-1))/=0)then
imgflag=1
endif

enddo
if(imgflag/=1)then
mglevg_allow=j
else
imgflag=0
endif



enddo

!write(*,*) 'mg block check, allowable mg level',mglevg_allow


if(mglevg>mglevg_allow)then
mglevg=mglevg_allow
write(*,*) 'Auto change mglevg due to block dimensions!'
endif

endif

mglevg_allow=1

!mg_bc check
if(num_bc /= 0) then
if(mglevg /= 1) then
do j=2,mglevg_max
do i=1,num_bc
c1=>c(i)



if(c1%face==2) then
nii=c1%ke-c1%ks+1
njj=c1%ie-c1%is+1


if(mod(nii-1,2**(j-1))/=0)then
imgflag=1
endif



elseif(c1%face==3) then
nii=c1%ie-c1%is+1
njj=c1%je-c1%js+1

if(mod(njj-1,2**(j-1))/=0)then
imgflag=1
endif

endif









enddo

if(imgflag/=1)then
mglevg_allow=j
else
imgflag=0
endif

enddo

!write(*,*) 'mg bc check, allowable mg level',mglevg_allow


if(mglevg>mglevg_allow)then
mglevg=mglevg_allow
write(*,*) 'Auto change mglevg due to bc dimensions!'
endif
endif
endif


mglevg_allow=1

if(num_if /= 0) then
if(mglevg /= 1) then
do j=2,mglevg_max
do i=1,num_if
f1=>f(i)



if(f1%face==2) then
nii=f1%ke-f1%ks+1
njj=f1%ie-f1%is+1



if(mod(nii-1,2**(j-1))/=0)then
imgflag=1
endif

elseif(f1%face==3) then
nii=f1%ie-f1%is+1
njj=f1%je-f1%js+1


if(mod(njj-1,2**(j-1))/=0)then
imgflag=1
endif

endif



enddo

if(imgflag/=1)then
mglevg_allow=j
else
imgflag=0
endif
enddo
!write(*,*) 'mg interface check, allowable mg level',mglevg_allow
if(mglevg>mglevg_allow)then
mglevg=mglevg_allow
write(*,*) 'Auto change mglevg due to interface dimensions!'
endif
endif
endif


!write(*,*) mglevg_allow_1,mglevg_allow_2,mglevg_allow_3



endif !!!
!write(*,*) 'Current mglevg=',mglevg


write(*,*) 'Current mglevg=',mglevg



















!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!cfl3d.inp

write(601,'(A)') 'I/O FILES'
write(601,'(A)') 'cfl3d.grd'
write(601,'(A)') 'plot3dg.bin'
write(601,'(A)') 'plot3dq.bin'
write(601,'(A)') 'cfl3d.out'
write(601,'(A)') 'cfl3d.res'
write(601,'(A)') 'cfl3d.turres'
write(601,'(A)') 'cfl3d.blomax'
write(601,'(A)') 'cfl3d.out15'
write(601,'(A)') 'cfl3d.prout'
write(601,'(A)') 'cfl3d.out20'
write(601,'(A)') 'ovrlp.bin'
write(601,'(A)') 'patch.bin'
write(601,'(A)') 'restart.bin'
write(601,'(A)') '>--begin keyword-driven input section'
write(601,'(A,I3)') 'ifullns',ifullns
write(601,'(A,F5.1)') 'cprec',cprec
write(601,'(A,F5.1)') 'epsa_r',epsa_r
write(601,'(A,F10.1)') 'edvislim',edvislim
write(601,'(A,I3)') 'iturbord',iturbord
write(601,'(A)') '<--end keyword-driven input section'
write(601,'(A)') 'CFDRC_FILES:'//trim(file1)//'&'//trim(file2)
write(601,'(7A10)') 'XMACH','ALPHA','BETA','REUE,MIL','TINF,DR','IALPH','IHSTRY'
write(601,'(5F10.4,2I10)') xmach,alpha,beta,reue,tinf_dr,ialph,ihstry
write(601,'(6A10)') 'SREF','CREF','BREF','XMC','YMC','ZMC'
write(601,'(6F10.6)') sref,cref,bref,xmc,ymc,zmc
write(601,'(6A10)') 'DT','IREST','IFLAGTS','FMAX','IUNST','CFLTAU'
write(601,'(F10.4,2I10,F10.4,I10,F10.4)') dt,irest,iflagts,fmax,iunst,cfltau
write(601,'(8A10)') 'NGRID','NPLOT3D','NPRINT','NWREST','ICHK','I2D','NTSTEP','ITA'
write(601,'(8I10)') ngrid,nplot3d,nprint,nwrest,ichk,i2d,ntstep,ita

write(601,'(7A10)') 'NCG','IEM','IADVANCE','IFORCE','IVISC(I)','IVISC(J)','IVISC(K)'

ncg=mglevg-1

iem=0
iadvance=0
do i=1,num_blk
if(ftyp(i)==1) then
iforce='333'
else
iforce='000'
endif
write(601,'(3I10,A10,3I10)') ncg,iem,iadvance,iforce,ivisc,ivisc,ivisc
enddo

write(601,'(3A10)') 'IDIM','JDIM','KDIM'
do i=1,num_blk
b1=>b(i)
write(601,'(3I10)') b1%ni,b1%nj,b1%nk
enddo

write(601,'(6A10)') 'ILAMLO','ILAMHI','JLAMLO','JLAMHI','KLAMLO','KLAMHI'
ilamlo=0
ilamhi=0
jlamlo=0
jlamhi=0
klamlo=0
klamhi=0
do i=1,num_blk
write(601,'(6I10)') ilamlo,ilamhi,jlamlo,jlamhi,klamlo,klamhi
enddo


write(601,'(8A10)') 'INEWG','IGRIDC','IS','JS','KS','IE','JE','KE'
inewg=0
igridc=0
do i=1,num_blk
write(601,'(8I10)') inewg,igridc,inewg,igridc,inewg,igridc,inewg,igridc
enddo

write(601,'(6A10)') 'IDIAG(I)','IDIAG(J)','IDIAG(K)','IFLIM(I)','IFLIM(J)','IFLIM(K)'
do i=1,num_blk
write(601,'(6I10)') idiag,idiag,idiag,iflim,iflim,iflim
enddo

write(601,'(6A10)') 'IFDS(I)','IFDS(J)','IFDS(K)','RKAP0(I)','RKAP0(J)','RKAP0(K)'
do i=1,num_blk
write(601,'(3I10,3F10.4)') ifds,ifds,ifds,rkap0,rkap0,rkap0
enddo


write(601,'(8A10)') 'GRID','NBCI0','NBCIDIM','NBCJ0','NBCJDIM','NBCK0','NBCKDIM','IOVRLP'
iovrlp=0
do i=1,num_blk
b1=>b(i)
write(601,'(8I10)') i,b1%num_i0,b1%num_idim,b1%num_j0,b1%num_jdim,b1%num_k0,b1%num_kdim,iovrlp
enddo


twratio=0d0
cq=0d0

write(601,'(8A10)') 'I0:   GRID','SEGMENT','BCTYPE','JSTA','JEND','KSTA','KEND','NDATA'


do i=1,num_blk
k=1
if(num_if /= 0) then
do j=1,num_if
f1=>f(j)
if(f1%blk1==i) then
if(f1%face==1) then
if(f1%side==1) then
ndata=0
write(601,'(8I10)') i,k,ndata,f1%js,f1%je,f1%ks,f1%ke,ndata
k=k+1
endif
endif
endif

enddo
endif

if(num_bc /= 0) then


do j=1,num_bc
c1=>c(j)
if(c1%blk==i) then
if(c1%face==1) then
if(c1%side==1) then

if(c1%typ_num==2004)then
ndata=2

if(isurfg==0)then

kk=1

elseif(isurfg<0)then

if(c1%nam==surfg)then
kk=-1
else
kk=1
endif

else

if(c1%nam==surfg)then
kk=1
else
kk=-1
endif

endif

write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(2A10)') 'tw/tinf','cq'
write(601,'(2F10.4)') twratio,cq

elseif(c1%typ_num==2002)then
ndata=1
write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(A10)') 'p/pinf'
write(601,'(F10.4)') pratio


else
ndata=0
write(601,'(8I10)') i,k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
endif
k=k+1
endif
endif
endif

enddo


endif


enddo


write(601,'(8A10)') 'IDIM: GRID','SEGMENT','BCTYPE','JSTA','JEND','KSTA','KEND','NDATA'

do i=1,num_blk
k=1
if(num_if /= 0) then
do j=1,num_if
f1=>f(j)
if(f1%blk1==i) then
if(f1%face==1) then
if(f1%side==2) then
ndata=0
write(601,'(8I10)') i,k,ndata,f1%js,f1%je,f1%ks,f1%ke,ndata
k=k+1
endif
endif
endif

enddo
endif

if(num_bc /= 0) then


do j=1,num_bc
c1=>c(j)
if(c1%blk==i) then
if(c1%face==1) then
if(c1%side==2) then

if(c1%typ_num==2004)then
ndata=2

if(isurfg==0)then

kk=1

elseif(isurfg<0)then

if(c1%nam==surfg)then
kk=-1
else
kk=1
endif

else

if(c1%nam==surfg)then
kk=1
else
kk=-1
endif

endif

write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(2A10)') 'tw/tinf','cq'
write(601,'(2F10.4)') twratio,cq


elseif(c1%typ_num==2002)then
ndata=1
write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(A10)') 'p/pinf'
write(601,'(F10.4)') pratio



else
ndata=0
write(601,'(8I10)') i,k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
endif
k=k+1
endif
endif
endif

enddo


endif


enddo


write(601,'(8A10)') 'J0:   GRID','SEGMENT','BCTYPE','ISTA','IEND','KSTA','KEND','NDATA'


do i=1,num_blk
k=1
if(num_if /= 0) then
do j=1,num_if
f1=>f(j)
if(f1%blk1==i) then
if(f1%face==2) then
if(f1%side==1) then
ndata=0
write(601,'(8I10)') i,k,ndata,f1%is,f1%ie,f1%ks,f1%ke,ndata
k=k+1
endif
endif
endif

enddo
endif

if(num_bc /= 0) then

do j=1,num_bc
c1=>c(j)
if(c1%blk==i) then
if(c1%face==2) then
if(c1%side==1) then

if(c1%typ_num==2004)then
ndata=2

if(isurfg==0)then

kk=1

elseif(isurfg<0)then

if(c1%nam==surfg)then
kk=-1
else
kk=1
endif

else

if(c1%nam==surfg)then
kk=1
else
kk=-1
endif

endif

write(601,'(8I10)') i,kk*k,c1%typ_num,c1%is,c1%ie,c1%ks,c1%ke,ndata
write(601,'(2A10)') 'tw/tinf','cq'
write(601,'(2F10.4)') twratio,cq

elseif(c1%typ_num==2002)then
ndata=1
write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(A10)') 'p/pinf'
write(601,'(F10.4)') pratio

else
ndata=0
write(601,'(8I10)') i,k,c1%typ_num,c1%is,c1%ie,c1%ks,c1%ke,ndata
endif
k=k+1
endif
endif
endif

enddo


endif


enddo
write(601,'(8A10)') 'JDIM: GRID','SEGMENT','BCTYPE','ISTA','IEND','KSTA','KEND','NDATA'


do i=1,num_blk
k=1
if(num_if /= 0) then
do j=1,num_if
f1=>f(j)
if(f1%blk1==i) then
if(f1%face==2) then
if(f1%side==2) then
ndata=0
write(601,'(8I10)') i,k,ndata,f1%is,f1%ie,f1%ks,f1%ke,ndata
k=k+1
endif
endif
endif

enddo
endif

if(num_bc /= 0) then

do j=1,num_bc
c1=>c(j)
if(c1%blk==i) then
if(c1%face==2) then
if(c1%side==2) then

if(c1%typ_num==2004)then
ndata=2

if(isurfg==0)then

kk=1

elseif(isurfg<0)then

if(c1%nam==surfg)then
kk=-1
else
kk=1
endif

else

if(c1%nam==surfg)then
kk=1
else
kk=-1
endif

endif

write(601,'(8I10)') i,kk*k,c1%typ_num,c1%is,c1%ie,c1%ks,c1%ke,ndata
write(601,'(2A10)') 'tw/tinf','cq'
write(601,'(2F10.4)') twratio,cq

elseif(c1%typ_num==2002)then
ndata=1
write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(A10)') 'p/pinf'
write(601,'(F10.4)') pratio

else
ndata=0
write(601,'(8I10)') i,k,c1%typ_num,c1%is,c1%ie,c1%ks,c1%ke,ndata
endif
k=k+1
endif
endif
endif

enddo


endif


enddo





write(601,'(8A10)') 'K0:   GRID','SEGMENT','BCTYPE','ISTA','IEND','JSTA','JEND','NDATA'


do i=1,num_blk
k=1
if(num_if /= 0) then
do j=1,num_if
f1=>f(j)
if(f1%blk1==i) then
if(f1%face==3) then
if(f1%side==1) then
ndata=0
write(601,'(8I10)') i,k,ndata,f1%is,f1%ie,f1%js,f1%je,ndata
k=k+1
endif
endif
endif

enddo
endif

if(num_bc /= 0) then

do j=1,num_bc
c1=>c(j)
if(c1%blk==i) then
if(c1%face==3) then
if(c1%side==1) then

if(c1%typ_num==2004)then
ndata=2

if(isurfg==0)then

kk=1

elseif(isurfg<0)then

if(c1%nam==surfg)then
kk=-1
else
kk=1
endif

else

if(c1%nam==surfg)then
kk=1
else
kk=-1
endif

endif

write(601,'(8I10)') i,kk*k,c1%typ_num,c1%is,c1%ie,c1%js,c1%je,ndata
write(601,'(2A10)') 'tw/tinf','cq'
write(601,'(2F10.4)') twratio,cq


elseif(c1%typ_num==2002)then
ndata=1
write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(A10)') 'p/pinf'
write(601,'(F10.4)') pratio

else
ndata=0
write(601,'(8I10)') i,k,c1%typ_num,c1%is,c1%ie,c1%js,c1%je,ndata
endif
k=k+1
endif
endif
endif

enddo


endif


enddo

write(601,'(8A10)') 'KDIM: GRID','SEGMENT','BCTYPE','ISTA','IEND','JSTA','JEND','NDATA'


do i=1,num_blk
k=1
if(num_if /= 0) then
do j=1,num_if
f1=>f(j)
if(f1%blk1==i) then
if(f1%face==3) then
if(f1%side==2) then
ndata=0
write(601,'(8I10)') i,k,ndata,f1%is,f1%ie,f1%js,f1%je,ndata
k=k+1
endif
endif
endif

enddo
endif

if(num_bc /= 0) then

do j=1,num_bc
c1=>c(j)
if(c1%blk==i) then
if(c1%face==3) then
if(c1%side==2) then

if(c1%typ_num==2004)then
ndata=2

if(isurfg==0)then

kk=1

elseif(isurfg<0)then

if(c1%nam==surfg)then
kk=-1
else
kk=1
endif

else

if(c1%nam==surfg)then
kk=1
else
kk=-1
endif

endif

write(601,'(8I10)') i,kk*k,c1%typ_num,c1%is,c1%ie,c1%js,c1%je,ndata
write(601,'(2A10)') 'tw/tinf','cq'
write(601,'(2F10.4)') twratio,cq

elseif(c1%typ_num==2002)then
ndata=1
write(601,'(8I10)') i,kk*k,c1%typ_num,c1%js,c1%je,c1%ks,c1%ke,ndata
write(601,'(A10)') 'p/pinf'
write(601,'(F10.4)') pratio

else
ndata=0
write(601,'(8I10)') i,k,c1%typ_num,c1%is,c1%ie,c1%js,c1%je,ndata
endif
k=k+1
endif
endif
endif

enddo


endif


enddo



write(601,'(5A10)') 'MSEQ','MGFLAG','ICONSF','MTT','NGAM'
if(mglevg==1) then


mgflag=0
else

mgflag=1
endif
mseq=mglevg

iconsf=1
mtt=0
ngam=2
write(601,'(5I10)') mseq,mgflag,iconsf,mtt,ngam


write(601,'(8A10)') 'ISSC','EPSSSC(1)','EPSSSC(2)','EPSSSC(3)','ISSR','EPSSSR(1)','EPSSSR(2)','EPSSSR(3)'

issc=0
issr=0
epsssc=0.3333d0
epsssr=0.3333d0

write(601,'(I10,3F10.4,I10,3F10.4)') issc,epsssc,epsssc,epsssc,issr,epsssr,epsssr,epsssr

write(601,'(4A10)') 'NCYC','MGLEVG','NEMGL','NITFO'




nemgl=0
nitfo=0
do i=1,mglevg
write(601,'(4I10)') ncyc(i),i,nemgl,nitfo
enddo


write(601,'(8A10)') 'MIT1','MIT2','MIT3','MIT4','MIT5','MIT6','MIT7','MIT8'


mit=1
do i=1,mglevg
write(601,'(8I10)') mit,mit,mit,mit,mit,mit,mit,mit
enddo

write(601,'(A21)') '1-1 BLOCKING DATA:'
write(601,'(A10)') 'NBLI'
write(601,'(I10)') num_ifp

write(601,'(10A8)') 'NUMBER','GRID :','ISTA','JSTA','KSTA','IEND','JEND','KEND','ISVA1','ISVA2'

!!!
k=0
do i=1,num_if
f1=>f(i)
do j=1,num_if
f2=>f(j)

if(i /= j) then
if(f1%pair<0) then
if(f2%pair<0) then
if(f1%key==f2%key)then
f1%pair=1
f2%pair=1
k=k+1
p1=>p(k)
p1%blk1=f1%blk1
p1%blk2=f2%blk1

p1%ii1=f1%face
p1%ii2=f2%face

p1%ss1=f1%side
p1%ss2=f2%side


p1%is1=f1%is
p1%is2=f2%is
p1%ie1=f1%ie
p1%ie2=f2%ie

p1%js1=f1%js
p1%js2=f2%js
p1%je1=f1%je
p1%je2=f2%je


p1%ks1=f1%ks
p1%ks2=f2%ks
p1%ke1=f1%ke
p1%ke2=f2%ke

endif
endif
endif
endif

!write(*,*) k

enddo
enddo






do j=1,3
do i=1,3
d(i,j)=0
enddo
enddo
d(1,1)=1
d(2,2)=1
d(3,3)=1


do i=1,num_ifp
p1=>p(i)
p1%jj1=1*d(p1%ii1,3)+2*d(p1%ii1,1)+3*d(p1%ii1,2)
p1%kk1=1*d(p1%ii1,2)+2*d(p1%ii1,3)+3*d(p1%ii1,1)
p1%jj2=1*d(p1%ii2,3)+2*d(p1%ii2,1)+3*d(p1%ii2,2)
p1%kk2=1*d(p1%ii2,2)+2*d(p1%ii2,3)+3*d(p1%ii2,1)
enddo

!pause

do i=1,num_ifp
p1=>p(i)
b1=>b(p1%blk1)
b2=>b(p1%blk2)

p1%i1=d(p1%ii1,1)*(d(p1%ss1,1)*p1%is1+d(p1%ss1,2)*p1%ie1)+d(p1%jj1,1)*p1%is1+d(p1%kk1,1)*p1%is1
p1%j1=d(p1%ii1,2)*(d(p1%ss1,1)*p1%js1+d(p1%ss1,2)*p1%je1)+d(p1%jj1,2)*p1%js1+d(p1%kk1,2)*p1%js1
p1%k1=d(p1%ii1,3)*(d(p1%ss1,1)*p1%ks1+d(p1%ss1,2)*p1%ke1)+d(p1%jj1,3)*p1%ks1+d(p1%kk1,3)*p1%ks1

p1%x1(1)=b1%x(p1%i1,p1%j1,p1%k1)
p1%y1(1)=b1%y(p1%i1,p1%j1,p1%k1)
p1%z1(1)=b1%z(p1%i1,p1%j1,p1%k1)

p1%i1=d(p1%ii1,1)*(d(p1%ss1,1)*p1%is1+d(p1%ss1,2)*p1%ie1)+d(p1%jj1,1)*p1%ie1+d(p1%kk1,1)*p1%is1
p1%j1=d(p1%ii1,2)*(d(p1%ss1,1)*p1%js1+d(p1%ss1,2)*p1%je1)+d(p1%jj1,2)*p1%je1+d(p1%kk1,2)*p1%js1
p1%k1=d(p1%ii1,3)*(d(p1%ss1,1)*p1%ks1+d(p1%ss1,2)*p1%ke1)+d(p1%jj1,3)*p1%ke1+d(p1%kk1,3)*p1%ks1

p1%x1(2)=b1%x(p1%i1,p1%j1,p1%k1)
p1%y1(2)=b1%y(p1%i1,p1%j1,p1%k1)
p1%z1(2)=b1%z(p1%i1,p1%j1,p1%k1)

p1%i1=d(p1%ii1,1)*(d(p1%ss1,1)*p1%is1+d(p1%ss1,2)*p1%ie1)+d(p1%jj1,1)*p1%is1+d(p1%kk1,1)*p1%ie1
p1%j1=d(p1%ii1,2)*(d(p1%ss1,1)*p1%js1+d(p1%ss1,2)*p1%je1)+d(p1%jj1,2)*p1%js1+d(p1%kk1,2)*p1%je1
p1%k1=d(p1%ii1,3)*(d(p1%ss1,1)*p1%ks1+d(p1%ss1,2)*p1%ke1)+d(p1%jj1,3)*p1%ks1+d(p1%kk1,3)*p1%ke1

p1%x1(3)=b1%x(p1%i1,p1%j1,p1%k1)
p1%y1(3)=b1%y(p1%i1,p1%j1,p1%k1)
p1%z1(3)=b1%z(p1%i1,p1%j1,p1%k1)

p1%i1=d(p1%ii1,1)*(d(p1%ss1,1)*p1%is1+d(p1%ss1,2)*p1%ie1)+d(p1%jj1,1)*p1%ie1+d(p1%kk1,1)*p1%ie1
p1%j1=d(p1%ii1,2)*(d(p1%ss1,1)*p1%js1+d(p1%ss1,2)*p1%je1)+d(p1%jj1,2)*p1%je1+d(p1%kk1,2)*p1%je1
p1%k1=d(p1%ii1,3)*(d(p1%ss1,1)*p1%ks1+d(p1%ss1,2)*p1%ke1)+d(p1%jj1,3)*p1%ke1+d(p1%kk1,3)*p1%ke1

p1%x1(4)=b1%x(p1%i1,p1%j1,p1%k1)
p1%y1(4)=b1%y(p1%i1,p1%j1,p1%k1)
p1%z1(4)=b1%z(p1%i1,p1%j1,p1%k1)

!pause

p1%i2=d(p1%ii2,1)*(d(p1%ss2,1)*p1%is2+d(p1%ss2,2)*p1%ie2)+d(p1%jj2,1)*p1%is2+d(p1%kk2,1)*p1%is2
p1%j2=d(p1%ii2,2)*(d(p1%ss2,1)*p1%js2+d(p1%ss2,2)*p1%je2)+d(p1%jj2,2)*p1%js2+d(p1%kk2,2)*p1%js2
p1%k2=d(p1%ii2,3)*(d(p1%ss2,1)*p1%ks2+d(p1%ss2,2)*p1%ke2)+d(p1%jj2,3)*p1%ks2+d(p1%kk2,3)*p1%ks2

p1%x2(1)=b2%x(p1%i2,p1%j2,p1%k2)
p1%y2(1)=b2%y(p1%i2,p1%j2,p1%k2)
p1%z2(1)=b2%z(p1%i2,p1%j2,p1%k2)

p1%i2=d(p1%ii2,1)*(d(p1%ss2,1)*p1%is2+d(p1%ss2,2)*p1%ie2)+d(p1%jj2,1)*p1%ie2+d(p1%kk2,1)*p1%is2
p1%j2=d(p1%ii2,2)*(d(p1%ss2,1)*p1%js2+d(p1%ss2,2)*p1%je2)+d(p1%jj2,2)*p1%je2+d(p1%kk2,2)*p1%js2
p1%k2=d(p1%ii2,3)*(d(p1%ss2,1)*p1%ks2+d(p1%ss2,2)*p1%ke2)+d(p1%jj2,3)*p1%ke2+d(p1%kk2,3)*p1%ks2

p1%x2(2)=b2%x(p1%i2,p1%j2,p1%k2)
p1%y2(2)=b2%y(p1%i2,p1%j2,p1%k2)
p1%z2(2)=b2%z(p1%i2,p1%j2,p1%k2)

p1%i2=d(p1%ii2,1)*(d(p1%ss2,1)*p1%is2+d(p1%ss2,2)*p1%ie2)+d(p1%jj2,1)*p1%is2+d(p1%kk2,1)*p1%ie2
p1%j2=d(p1%ii2,2)*(d(p1%ss2,1)*p1%js2+d(p1%ss2,2)*p1%je2)+d(p1%jj2,2)*p1%js2+d(p1%kk2,2)*p1%je2
p1%k2=d(p1%ii2,3)*(d(p1%ss2,1)*p1%ks2+d(p1%ss2,2)*p1%ke2)+d(p1%jj2,3)*p1%ks2+d(p1%kk2,3)*p1%ke2

p1%x2(3)=b2%x(p1%i2,p1%j2,p1%k2)
p1%y2(3)=b2%y(p1%i2,p1%j2,p1%k2)
p1%z2(3)=b2%z(p1%i2,p1%j2,p1%k2)

p1%i2=d(p1%ii2,1)*(d(p1%ss2,1)*p1%is2+d(p1%ss2,2)*p1%ie2)+d(p1%jj2,1)*p1%ie2+d(p1%kk2,1)*p1%ie2
p1%j2=d(p1%ii2,2)*(d(p1%ss2,1)*p1%js2+d(p1%ss2,2)*p1%je2)+d(p1%jj2,2)*p1%je2+d(p1%kk2,2)*p1%je2
p1%k2=d(p1%ii2,3)*(d(p1%ss2,1)*p1%ks2+d(p1%ss2,2)*p1%ke2)+d(p1%jj2,3)*p1%ke2+d(p1%kk2,3)*p1%ke2

p1%x2(4)=b2%x(p1%i2,p1%j2,p1%k2)
p1%y2(4)=b2%y(p1%i2,p1%j2,p1%k2)
p1%z2(4)=b2%z(p1%i2,p1%j2,p1%k2)

!pause

dmin=1d10
do j=1,4
dist1=(p1%x2(1)-p1%x1(j))**2+(p1%y2(1)-p1%y1(j))**2+(p1%z2(1)-p1%z1(j))**2
if(dist1<dmin)then
dmin=dist1
ii=j
endif
enddo

!pause

if(ii==1)then

dist1=(p1%x2(2)-p1%x1(2))**2+(p1%y2(2)-p1%y1(2))**2+(p1%z2(2)-p1%z1(2))**2
dist2=(p1%x2(2)-p1%x1(3))**2+(p1%y2(2)-p1%y1(3))**2+(p1%z2(2)-p1%z1(3))**2
if(dist1<dist2)then
p1%link=1
p1%dir1=1
p1%dir2=1
else
p1%link=2
p1%dir1=1
p1%dir2=1
endif

elseif(ii==2)then

dist1=(p1%x2(2)-p1%x1(1))**2+(p1%y2(2)-p1%y1(1))**2+(p1%z2(2)-p1%z1(1))**2
dist2=(p1%x2(2)-p1%x1(4))**2+(p1%y2(2)-p1%y1(4))**2+(p1%z2(2)-p1%z1(4))**2
if(dist1<dist2)then
p1%link=1
p1%dir1=2
p1%dir2=1
else
p1%link=2
p1%dir1=1
p1%dir2=2
endif


elseif(ii==3)then

dist1=(p1%x2(2)-p1%x1(4))**2+(p1%y2(2)-p1%y1(4))**2+(p1%z2(2)-p1%z1(4))**2
dist2=(p1%x2(2)-p1%x1(1))**2+(p1%y2(2)-p1%y1(1))**2+(p1%z2(2)-p1%z1(1))**2
if(dist1<dist2)then
p1%link=1
p1%dir1=1
p1%dir2=2
else
p1%link=2
p1%dir1=2
p1%dir2=1
endif

elseif(ii==4)then


dist1=(p1%x2(2)-p1%x1(3))**2+(p1%y2(2)-p1%y1(3))**2+(p1%z2(2)-p1%z1(3))**2
dist2=(p1%x2(2)-p1%x1(2))**2+(p1%y2(2)-p1%y1(2))**2+(p1%z2(2)-p1%z1(2))**2
if(dist1<dist2)then
p1%link=1
p1%dir1=2
p1%dir2=2
else
p1%link=2
p1%dir1=2
p1%dir2=2
endif

endif
write(601,'(10I8)') i,p1%blk1,p1%is1,p1%js1,p1%ks1,p1%ie1,p1%je1,p1%ke1,p1%jj1,p1%kk1

p1%jj3=p1%jj2
p1%kk3=p1%kk2
p1%is3=p1%is2
p1%ie3=p1%ie2
p1%js3=p1%js2
p1%je3=p1%je2
p1%ks3=p1%ks2
p1%ke3=p1%ke2


if(p1%link /= 1) then
p1%jj3=p1%kk2
p1%kk3=p1%jj2
endif


if(p1%dir1 /= 1) then
if(p1%ii2 == 1) then
p1%js3=p1%je2
p1%je3=p1%js2
elseif(p1%ii2 == 2) then
p1%ks3=p1%ke2
p1%ke3=p1%ks2
elseif(p1%ii2 == 3) then
p1%is3=p1%ie2
p1%ie3=p1%is2
endif
endif



if(p1%dir2 /= 1) then
if(p1%ii2 == 1) then
p1%ks3=p1%ke2
p1%ke3=p1%ks2
elseif(p1%ii2 == 2) then
p1%is3=p1%ie2
p1%ie3=p1%is2
elseif(p1%ii2 == 3) then
p1%js3=p1%je2
p1%je3=p1%js2
endif
endif


enddo




write(601,'(10A8)') 'NUMBER','GRID :','ISTA','JSTA','KSTA','IEND','JEND','KEND','ISVA1','ISVA2'

do i=1,num_ifp
p1=>p(i)
write(601,'(10I8)') i,p1%blk2,p1%is3,p1%js3,p1%ks3,p1%ie3,p1%je3,p1%ke3,p1%jj3,p1%kk3
enddo


write(601,'(A21)') 'PATCH SURFACE DATA:'

write(601,'(A10)') 'NINTER'

if(ipatchflag==1)then
open(605,file='ronnie.inp')
write(*,*) 'Generate ronnie.inp'
write(605,'(A)') 'I/O FILES'
write(605,'(A)') 'cfl3d.grd'
write(605,'(A)') 'ronnie.out'
write(605,'(A)') 'patch.bin'
write(605,'(A)') 'IOFLAG ITRACE'
ioflag=1
itrace=-1
write(605,'(2I5)') ioflag,itrace
write(605,'(A)') 'CFDRC_FILES:'//trim(pfgd)//'&'//trim(ibc)
write(605,'(A10)') 'NGRID'
write(605,'(I10)') ngrid
write(605,'(5A10)') 'NCG','IEM','IDIM','JDIM','KDIM'
do i=1,num_blk
b1=>b(i)
write(605,'(5I10)') ncg,iem,b1%ni,b1%nj,b1%nk
enddo
write(605,'(A10)') 'NINTER'
write(605,'(I10)') ninter
write(605,'(8A10)') 'INT','IIFIT','LLMIT','IITMAX','MMCXIE','MMCETA','IIC0','IIORPH'

iifit=1
llmit=1
iitmax=100
mmcxie=0
mmceta=0
iic0=0
iiorph=0
do i=1,ninter
write(605,'(8I10)') i,iifit,llmit,iitmax,mmcxie,mmceta,iic0,iiorph
enddo


write(605,'(A)') 'INT    TO   XIE1  XIE2   ETA1   ETA2   NFB (one per int)'
write(605,'(A)')  'FROM   XIE1  XIE2   ETA1   ETA2       (repeat nfb times for each int)'



ninter=0
do j=1,num_bcg
if(ipatch(j)==1) then

do i=1,num_bc

c1=>c(i)
if(c1%bcg==j) then
ninter=ninter+1
!write(*,*) 'TO',i,c1%blk*100+c1%face*10+c1%side

if(c1%face==1) then
iis=c1%js
iie=c1%je
jjs=c1%ks
jje=c1%ke
elseif(c1%face==2) then
iis=c1%ks
iie=c1%ke
jjs=c1%is
jje=c1%ie
else
iis=c1%js
iie=c1%je
jjs=c1%is
jje=c1%ie
endif
!bcg_num(bcg_pair(j))
!bcg_pair(j)
write(605,'(7I10)') ninter,c1%blk*100+c1%face*10+c1%side,iis,iie,jjs,jje,bcg_num(bcg_pair(j))
do k=1,num_bc
c2=>c(k)

if(c2%bcg==bcg_pair(j)) then
!write(*,*) 'FROM',k,c2%blk*100+c2%face*10+c2%side
if(c2%face==1) then
iis=c2%js
iie=c2%je
jjs=c2%ks
jje=c2%ke
elseif(c2%face==2) then
iis=c2%ks
iie=c2%ke
jjs=c2%is
jje=c2%ie
else
iis=c2%js
iie=c2%je
jjs=c2%is
jje=c2%ie
endif
write(605,'(I20,4I10)') c2%blk*100+c2%face*10+c2%side,iis,iie,jjs,jje
endif
enddo

endif
enddo


endif
enddo











ninter=-1
else
ninter=0
endif

write(601,'(I10)') ninter


write(601,'(A16)') 'PLOT3D OUTPUT:'

write(601,'(11A7)') 'GRID','IPTYPE','ISTART','IEND','IINC','JSTART','JEND','JINC','KSTART','KEND','KINC'


iptype=0

do i=1,num_blk
write(601,'(11I7)') i,iptype,iptype,iptype,iptype,iptype,iptype,iptype,iptype,iptype,iptype
enddo


write(601,'(A10)') 'IMOVIE'


imovie=0
write(601,'(I10)') imovie


write(601,'(A16)') 'PRINT OUT:'

write(601,'(11A7)') 'GRID','IPTYPE','ISTART','IEND','IINC','JSTART','JEND','JINC','KSTART','KEND','KINC'

write(601,'(A21)') 'CONTROL SURFACE:'

write(601,'(A10)') 'NCS'



!ncs=0

write(601,'(I10)') ncs
write(601,'(9A7)') 'GRID','ISTART','IEND','JSTART','JEND','KSTART','KEND','IWALL','INORM'

if(ncs/=0)then


do i=1,num_bc
c1=>c(i)
!b1=>b(c1%blk)

!!! control surface
if(c1%nam==csname) then

write(601,'(9I8)') c1%blk,c1%is,c1%ie,c1%js,c1%je,c1%ks,c1%ke,0,1


endif



enddo




endif



endprogram cfdrc_to_cfl3d 




