!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! WRITE_GLOBAL_OUTPUT Nov. 2006 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine write_global_output (params,istep,iter,current_time,osolve,ov, &
vo,surface,cl,zi,nest,outputtype)
!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
! subroutine to generate large global output files in subdirectory OUT
! the files contain:
! - array lengths
! - nodal values
! - icon array
! - octree array
! - bad faces array
! - void arrays
! - surface information
! istep is time step
! osolve is solve octree
! surface are surfaces
! ns is number of surfaces
! see code for details and order of output
! Note that if you modify this routine, you may also need to modify
! define_ov.f90, define_cloud.f90, and define_surface.f90
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine arguments ))))))))))))))))))))
!------------------------------------------------------------------------------|
use definitions
!use mpi
implicit none
include 'mpif.h'
type (parameters) params
integer istep,iter
double precision current_time
type (octreesolve) osolve
type (octreev) ov
type (void) vo
type (sheet) surface(params%ns)
type (cloud) cl
type (ziso) zi
type (nest_info) :: nest
!double precision zisodisp(2**params%levelmax_oct+1,2**params%levelmax_oct+1)
character*5 outputtype
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|
integer i,j,is,k
integer iproc,nproc,ierr
character*4 cistep,citer
character(len=5) :: outdir
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
call mpi_comm_size (mpi_comm_world,nproc,ierr)
call mpi_comm_rank (mpi_comm_world,iproc,ierr)
if (iproc.eq.0) then
if (params%nest) then
outdir='SSOUT'
else
outdir='OUT'
endif
call int_to_char (cistep,4,istep)
select case (outputtype)
case ('debug')
call int_to_char (citer,4,iter)
open (9,file=trim(outdir)//'/time_'//cistep//'_'//citer//'.bin',status='unknown',form='unformatted')
case ('final')
open (9,file=trim(outdir)//'/time_'//cistep//'.bin',status='unknown',form='unformatted')
! open (1234,file='OUT/time_'//cistep//'.dat',status='replace')
case default
call stop_run ('pb with argument in write_global_output$')
end select
! write array lengths
write (9) osolve%octree(3), &
osolve%nnode, &
osolve%nleaves, &
osolve%nface, &
osolve%nlsf, &
cl%np, &
current_time
! write info on octree solve nodes (x,y,z,u,v,w,lsf,temp)
write (9) (osolve%x(i), &
osolve%y(i), &
osolve%z(i)*params%vex, &
osolve%u(i), &
osolve%v(i), &
osolve%w(i), &
osolve%wiso(i), &
(osolve%lsf(i,j),j=1,osolve%nlsf), &
osolve%temp(i), &
ov%temporary_nodal_pressure(i), &
osolve%strain(i), &
osolve%kfix((i-1)*3+1), &
osolve%kfix((i-1)*3+2), &
osolve%kfix((i-1)*3+3), &
osolve%kfixt(i), &
i=1,osolve%nnode)
! write icon array
write (9) ((osolve%icon(k,i),k=1,8), &
! Line below uncommented by dwhipp - 12/09
osolve%pressure(i), &
! Line below added by dwhipp - 12/09
osolve%spressure(i), &
osolve%crit(i), &
osolve%e2d(i), &
osolve%eviscosity(i), &
osolve%is_plastic(i), &
osolve%dilatr(i), &
osolve%matnum(i), &
ov%whole_leaf_in_fluid(i), &
i=1,osolve%nleaves)
! write octree information
write (9) (osolve%octree(i),i=1,osolve%octree(3))
! write bad face information
write (9) ((osolve%iface(k,i),k=1,9),i=1,osolve%nface)
! write void information
write (9) (vo%node(i), &
vo%leaf(i), &
vo%ftr(i), &
vo%rtf(i), &
vo%influid(i), &
i=1,osolve%nnode)
! write bad faces information
write (9) (vo%face(i),i=1,osolve%nface)
! write surface information (r,s,x,y,z,xn,yn,zn)
do is=1,osolve%nlsf
write (9) surface(is)%nsurface, &
surface(is)%activation_time, &
surface(is)%nt
select case (outputtype)
case ('debug')
write (9) (surface(is)%r(i), &
surface(is)%s(i), &
surface(is)%x(i), &
surface(is)%y(i), &
surface(is)%z(i)*params%vex, &
surface(is)%xn(i) ,&
surface(is)%yn(i), &
surface(is)%zn(i)*params%vex, &
i=1,surface(is)%nsurface)
case ('final')
write (9) (surface(is)%r(i), &
surface(is)%s(i), &
surface(is)%x(i), &
surface(is)%y(i), &
surface(is)%z(i)*params%vex, &
surface(is)%xn(i) ,&
surface(is)%yn(i), &
surface(is)%zn(i)*params%vex, &
surface(is)%u(i), &
surface(is)%v(i), &
surface(is)%w(i), &
i=1,surface(is)%nsurface)
end select
write (9) (surface(is)%icon(1:3,i),i=1,surface(is)%nt)
enddo
! write cloud information
write (9) (cl%x(i), &
cl%y(i), &
cl%z(i)*params%vex, &
cl%x0(i), &
cl%y0(i), &
cl%z0(i)*params%vex, &
cl%strain(i), &
cl%lsf0(i), &
cl%temp(i), &
cl%press(i), &
cl%tag(i), &
i=1,cl%np)
if (params%isobc) then
! write isostasy basal displacement array - dwhipp 11/09
write (9) 2**params%levelmax_oct
write (9) ((zi%zisodisp(i,j)+surface(osolve%nlsf)%sp01,&
j=1,2**params%levelmax_oct+1),i=1,2**params%levelmax_oct+1)
end if
if (params%nest) then
! write nested model info - dwhipp 05/11
write(9) nest%sselemx,nest%sselemy,nest%sselemz,nest%xminls,nest%yminls,&
nest%zminls
endif
close (9)
! do i=1,osolve%nnode
! if (abs(osolve%x(i)-0.5d0)<1.d-6 .and. osolve%z(i)<0.08d0) then
! write (1234,'(5f30.15)') osolve%y(i),osolve%z(i),osolve%v(i),osolve%w(i),ov%temporary_nodal_pressure(i)
! end if
! end do
! close (1234)
end if
return
end
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|