implicit none

 real :: pitch,k,m(60000),saisyou,referline,span,mm(60000),r(60000,2)
 real :: e,l,el1(90000,2),el2(90000,2),elb,ras,height(90000),ri,rii,ame
 integer :: i,data,ios,data2
 character(2) :: dirnamere
 character(4) :: csv
 character(9) :: filecsv2
 character(9) :: filecsv4
 character(1000) :: filename,filecsv,dirname,dirname2
 character(1000) :: linebuf,linebuf2,linebuf3,s,inout



 print *,'算術平均粗さ(mm)を求め，算出するファイルの余分な"0"をカットします。'
 print *,'このプログラムでは表面の傾き，うねりを補正しません。'

 print *,"算術平均粗さを求めたいファイル名の入力（拡張子不要）"
  read *,filename

!!!!!!!!!!!!!!!!!!!測定ピッチの変更はこちら!!!!!!!!!!!!!!!!
  pitch=2.5
!!!!!!!!!!!!!!!!!!!変更ここまで!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  csv='.csv'
  filecsv=trim(adjustl(filename))//csv
  filecsv2='test1.csv'


 print *,"測定ピッチ(mm)は",pitch

  call chdir(dirname)

  open(11,file = filecsv)
    do i=1,60000
     k=0
     read(11,*,iostat=ios),k

      if(ios < 0)exit
      if(k == 0)exit

     m(i)=k
     data=i
    end do
  close(11)

  saisyou=0
  do i=1,data
   saisyou=saisyou+m(i)
  end do

  referline=saisyou/data

 print *,"平均線は：",referline

  span=pitch*(data-1)
 print *,"測定スパン(mm)は：",span

  do i=1,data
   mm(i)=0
   mm(i)=(m(i)-referline)
  end do


   open(12,file = filecsv2,status='replace')
    do i=1,data

     if( i == data )then
      write(linebuf,*),mm(i),',',pitch*(i-1)
       call del_spaces(linebuf)
      write(12,'(A)'),trim(linebuf)
     else
      if( (mm(i) == 0).and.(mm(i+1) == 0) )then
       write(linebuf,*),mm(i),',',pitch*(i-1)
        call del_spaces(linebuf)
       write(12,'(A)'),trim(linebuf)
      else
       if( (mm(i) < 0).and.(mm(i+1) < 0) )then
        write(linebuf,*),mm(i),',',pitch*(i-1)
         call del_spaces(linebuf)
        write(12,'(A)'),trim(linebuf)
       else
        if( (mm(i) > 0).and.(mm(i+1) > 0) )then
         write(linebuf,*),mm(i),',',pitch*(i-1)
          call del_spaces(linebuf)
         write(12,'(A)'),trim(linebuf)
        else
         write(linebuf,*),mm(i),',',pitch*(i-1)
          call del_spaces(linebuf)
         write(12,'(A)'),trim(linebuf)
         write(linebuf2,*),0,',',pitch*(i-1)
          call del_spaces(linebuf2)
         write(12,'(A)'),trim(linebuf2)
        end if
       end if
      end if
     end if

    end do
   close(12)


   open(13,file = filecsv2,status='old')
    do i=1,90000
      e=0
      l=0
     read(13,*,iostat=ios),e,l
     
      if(ios < 0)exit
      
     el1(i,1)=e
     el1(i,2)=l
     data2=i
    end do
   close(13)
   
   el2(1,1)=el1(1,1)
   el2(1,2)=el1(1,2)
   el2(data2,1)=el1(data2,1)
   el2(data2,2)=el1(data2,2)
   do i=2,data2-1
    elb=0
     if( (el1(i-1,1) /= 0).and.(el1(i,1) == 0).and.(el1(i+1,1) /= 0) )then
      elb=abs(el1(i-1,1))/( abs(el1(i-1,1))+abs(el1(i+1,1)) )
      el2(i,1)=el1(i,1)
      el2(i,2)=el1(i,2)+(pitch*elb)
     else
      el2(i,1)=el1(i,1)
      el2(i,2)=el1(i,2)
     end if
    end do

  filecsv4='test2.csv'
  open(14,file =filecsv4,status='replace')
   do i=1,data2
    write(linebuf3,*),el2(i,1),',',el2(i,2)
     call del_spaces(linebuf3)
    write(14,'(A)'),trim(linebuf3)
   end do
  close(14)


   do i=1,data2-1
    height(i)=el2(i+1,2)-el2(i,2)
   end do

   ras=0
   do i=1,data-1
      ri=0
     rii=0

    ri=abs(el2(i,1))
   rii=abs(el2(i+1,1))
   ras=ras+( ri+rii )*height(i)/2
  end do

 ame=ras/span

 print *,"算術平均粗さRa(mm)は：",ame


end





!日本NAG fortranTip集
!http://www.nag-j.co.jp/fortran/tips/code/write-nospace-csv.f90 より引用
 subroutine del_spaces(s)
    character (*), intent (inout) :: s
    character (len=len(s)) tmp
    integer i, j
    j = 1
    do i = 1, len(s)
      if (s(i:i)==' ') cycle
      tmp(j:j) = s(i:i)
      j = j + 1
    end do
    s = tmp(1:j-1)
 end subroutine del_spaces 

