Skip to content
Snippets Groups Projects
write_global_output.new.f90 7.66 KiB
Newer Older
  • Learn to ignore specific revisions
  • !------------------------------------------------------------------------------|
    !------------------------------------------------------------------------------|
    !                                                                              |
    !              ||===\\                                                         | 
    !              ||    \\                                                        |
    !              ||     ||   //==\\   ||  ||   //==||  ||/==\\                   |
    !              ||     ||  ||    ||  ||  ||  ||   ||  ||    ||                  |
    !              ||    //   ||    ||  ||  ||  ||   ||  ||                        |
    !              ||===//     \\==//    \\==\\  \\==\\  ||                        |
    !                                                                              |
    !------------------------------------------------------------------------------|
    !------------------------------------------------------------------------------|
    !                                                                              |
    !              WRITE_GLOBAL_OUTPUT     Nov. 2006                               |
    !                                                                              |
    !------------------------------------------------------------------------------|
    !------------------------------------------------------------------------------|
    
    subroutine write_global_output (params,istep,iter,current_time,osolve,ov, &
                                    vo,surface,cl,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
    
    implicit none
    
    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
    character*5 outputtype
    
    !------------------------------------------------------------------------------|
    !(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
    !------------------------------------------------------------------------------|
    
    integer i,j,is,k
    integer iproc,nproc,ierr
    character*4 cistep,citer
    integer no,nn,nl,nf,ns,np,nsi4,nsi8,i4,i8,lrecord
    
    !------------------------------------------------------------------------------|
    !------------------------------------------------------------------------------|
    
    INCLUDE 'mpif.h'
    
    call mpi_comm_size (mpi_comm_world,nproc,ierr)
    call mpi_comm_rank (mpi_comm_world,iproc,ierr)
    
    if (iproc.eq.0) then
    
    ! i4 and i8 are the units to be used for a single and a double real
    
       i4=1
       i8=i4*2
    
    ! first calculates the record length
    
       no=osolve%octree(3)
       nn=osolve%nnode
       nl=osolve%nleaves
       nf=osolve%nface
       ns=osolve%nlsf
       np=cl%np
    
       select case (outputtype)
    
       case ('debug')
    
         nsi4=0
         nsi8=0
           do is=1,ns
           nsi4=nsi4+2+3*surface(is)%nt
           nsi8=nsi8+1+8*surface(is)%nsurface
           enddo
    
       case ('final') 
    
         nsi4=0
         nsi8=0
           do is=1,ns
           nsi4=nsi4+2+3*surface(is)%nt
           nsi8=nsi8+1+11*surface(is)%nsurface
           enddo
    
       case default
    
          call stop_run ('pb with argument in write_global_output$')
    
       end select
    
       lrecord=6*i4+i8 &
              +6*i8*nn &
              +(ns+2)*i8*nn &
              +i8*nn+4*i4*nn &
              +9*i4*nl+2*i8*nl &
              +i4*no+9*i4*nf &
              +i4*(5*nn+nf) &
              +i4*nsi4+i8*nsi8 &
              +i4*np+10*i8*np
    
    ! then open the file
    
       write (cistep,'(i4)') istep
       if (istep.lt.1000) cistep(1:1)='0'
       if (istep.lt.100) cistep(1:2)='00'
       if (istep.lt.10) cistep(1:3)='000'
       select case (outputtype)
          case ('debug')
             write (citer,'(i4)') iter
             if (iter.lt.1000) citer(1:1)='0'
             if (iter.lt.100) citer(1:2)='00'
             if (iter.lt.10) citer(1:3)='000'
             open (9,file='OUT/time_'//cistep//'_'//citer//'.txt',status='unknown', &
                   access='direct',form='unformatted',recl=lrecord)
          case ('final')
             open (9,file='OUT/time_'//cistep//'.txt',status='unknown', &
                   access='direct',form='unformatted',recl=lrecord)
       end select
    
    ! write to the file
    
       select case (outputtype)
    
          case ('debug')
          write (9,rec=1) no,nn,nl,nf,ns,np,current_time, &
          osolve%x(1:nn),osolve%y(1:nn),osolve%z(1:nn),osolve%u(1:nn),osolve%v(1:nn),osolve%w(1:nn), &
          (osolve%lsf(1:nn,j),j=1,ns),osolve%temp(1:nn),ov%temporary_nodal_pressure(1:nn), &
          osolve%strain(1:nn),osolve%kfix(1:3*nn),osolve%kfixt(1:nn), &
          osolve%icon(1:8,1:nl),osolve%crit(1:nl),osolve%e2d(1:nl),ov%whole_leaf_in_fluid(1:nl), &
          osolve%octree(1:no),osolve%iface(1:9,1:nf), &
          vo%node(1:nn),vo%leaf(1:nn),vo%ftr(1:nn),vo%rtf(1:nn),vo%influid(1:nn),vo%face(1:nf),&
          (surface(is)%nsurface,surface(is)%activation_time,surface(is)%nt, &
           surface(is)%r(1:surface(is)%nsurface), surface(is)%s(1:surface(is)%nsurface),  &
           surface(is)%x(1:surface(is)%nsurface),surface(is)%y(1:surface(is)%nsurface),  &
           surface(is)%z(1:surface(is)%nsurface),surface(is)%xn(1:surface(is)%nsurface) ,&
           surface(is)%yn(1:surface(is)%nsurface),surface(is)%zn(1:surface(is)%nsurface), &
           surface(is)%icon(1:3,1:surface(is)%nt),is=1,ns), &
          cl%x(1:np),cl%y(1:np),cl%z(1:np),cl%x0(1:np),cl%y0(1:np),cl%z0(1:np),     &
          cl%strain(1:np),cl%lsf0(1:np),cl%temp(1:np),cl%press(1:np),cl%tag(1:np)
    
          case ('final')
          write (9,rec=1) no,nn,nl,nf,ns,np,current_time, &
          osolve%x(1:nn),osolve%y(1:nn),osolve%z(1:nn),osolve%u(1:nn),osolve%v(1:nn),osolve%w(1:nn), &
          (osolve%lsf(1:nn,j),j=1,ns),osolve%temp(1:nn),ov%temporary_nodal_pressure(1:nn), &
          osolve%strain(1:nn),osolve%kfix(1:3*nn),osolve%kfixt(1:nn), &
          osolve%icon(1:8,1:nl),osolve%crit(1:nl),osolve%e2d(1:nl),ov%whole_leaf_in_fluid(1:nl), &
          osolve%octree(1:no),osolve%iface(1:9,1:nf), &
          vo%node(1:nn),vo%leaf(1:nn),vo%ftr(1:nn),vo%rtf(1:nn),vo%influid(1:nn),vo%face(1:nf),&
          (surface(is)%nsurface,surface(is)%activation_time,surface(is)%nt, &
           surface(is)%r(1:surface(is)%nsurface), surface(is)%s(1:surface(is)%nsurface),  &
           surface(is)%x(1:surface(is)%nsurface),surface(is)%y(1:surface(is)%nsurface),  &
           surface(is)%z(1:surface(is)%nsurface),surface(is)%xn(1:surface(is)%nsurface) ,&
           surface(is)%yn(1:surface(is)%nsurface),surface(is)%zn(1:surface(is)%nsurface), &
           surface(is)%u(1:surface(is)%nsurface),surface(is)%v(1:surface(is)%nsurface),  &
           surface(is)%w(1:surface(is)%nsurface),  &
           surface(is)%icon(1:3,1:surface(is)%nt),is=1,ns), &
          cl%x(1:np),cl%y(1:np),cl%z(1:np),cl%x0(1:np),cl%y0(1:np),cl%z0(1:np),     &
          cl%strain(1:np),cl%lsf0(1:np),cl%temp(1:np),cl%press(1:np),cl%tag(1:np)
    
       end select
    
    ! finally close the file
    
       close (9)
    
    end if
    
    return
    end
    
    !------------------------------------------------------------------------------|
    !------------------------------------------------------------------------------|