data_saveA7_R Subroutine

subroutine data_saveA7_R(pname, Y1, order, wspace)

Arguments

Type IntentOptional Attributes Name
character(len=*) :: pname
real(kind=8), dimension(:,:,:,:,:,:,:) :: Y1
character(len=*), optional :: order
logical, optional :: wspace

Calls

proc~~data_savea7_r~2~~CallsGraph proc~data_savea7_r~2 data_saveA7_R file_gzip file_gzip proc~data_savea7_r~2->file_gzip free_unit free_unit proc~data_savea7_r~2->free_unit reg reg proc~data_savea7_r~2->reg

Source Code

subroutine data_saveA7_R(pname,Y1,order,wspace)
  integer                          :: Ny1,Ny2,Ny3,Ny4,Ny5,Ny6,Ny7
  integer                          :: i1,i2,i3,i4,i5,i6,i7
  character(len=*)                 :: pname
  real(8),dimension(:,:,:,:,:,:,:) :: Y1
  character(len=*),optional        :: order
  logical,optional                 :: wspace
  character(len=1)                 :: order_
  logical                          :: wspace_
  order_ = "R"   ; if(present(order))order_=trim(order(1:1))
  wspace_= .true.; if(present(wspace))wspace_=wspace
  open(free_unit(unit),file=reg(pname))
  Ny1=size(Y1,1)
  Ny2=size(Y1,2)
  Ny3=size(Y1,3)
  Ny4=size(Y1,4)
  Ny5=size(Y1,5)
  Ny6=size(Y1,6)
  Ny7=size(Y1,7)
  !
  select case(order_)
  case default
     stop "save_array: order != Row-major, Col-major"
  case ("R")
     do i1=1,Ny1
        do i2=1,Ny2
           do i3=1,Ny3
              do i4=1,Ny4
                 do i5=1,Ny5
                    do i6=1,Ny6
                       do i7=1,Ny7
                          write(unit,*)Y1(i1,i2,i3,i4,i5,i6,i7)
                       enddo
                       if(wspace_)write(unit,*)
                    enddo
                 enddo
              enddo
           enddo
        enddo
     enddo
  case ("C")
     do i7=1,Ny7
        do i6=1,Ny6
           do i5=1,Ny5
              do i4=1,Ny4
                 do i3=1,Ny3
                    do i2=1,Ny2
                       do i1=1,Ny1
                          write(unit,*)Y1(i1,i2,i3,i4,i5,i6,i7)
                       enddo
                       if(wspace_)write(unit,*)
                    enddo
                 enddo
              enddo
           enddo
        enddo
     enddo
  end select
  close(unit)
  call file_gzip(reg(pname))
end subroutine data_saveA7_R