write_global_output.f90

!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!                                                                              |
!              ||===\\                                                         | 
!              ||    \\                                                        |
!              ||     ||   //==\\   ||  ||   //==||  ||/==\\                   |
!              ||     ||  ||    ||  ||  ||  ||   ||  ||    ||                  |
!              ||    //   ||    ||  ||  ||  ||   ||  ||                        |
!              ||===//     \\==//    \\==\\  \\==\\  ||                        |
!                                                                              |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!                                                                              |
!              WRITE_GLOBAL_OUTPUT     Nov. 2006                               |
!                                                                              |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|

subroutine write_global_output (params,istep,iter,current_time,osolve,ov, &
                                vo,surface,cl,zi,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
!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=7) :: outdir

!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|

call mpi_comm_size (mpi_comm_world,nproc,ierr)
call mpi_comm_rank (mpi_comm_world,iproc,ierr)

if (iproc.eq.0) then
   call int_to_char (cistep,4,istep)
   select case (outputtype)
      if (params%nest) then
        outdir='NESTOUT'
      else
        outdir='OUT'
      endif
      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),          &
                 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

   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

!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|