program nn
use precis; use utilmod; use network

implicit none
integer, allocatable :: ideck(:)
integer nread,nbatch,verbose,iseed(1)
integer nalpha,init,irec,ibatch,iread,ii,iii,jjj
real(mrl) alpha0,alphai,alpha
real time,timel
character(80) filea,fileb,filec,netin,netout
character(1000) aline,bline
namelist/params/ima,ifuna,funcoa,nread,nbatch,iseed,&
  alpha0,nalpha,alphai,filea,fileb,filec,verbose,init,netin,netout

print *,' usage: nn < namelist_input_file > summary_output_file'
read (*,nml=params)

call allocate_network

if (init.eq.1) then
  call random_init_network(iseed)
else if(init.eq.2) then
  call half_init_network
else if (init.eq.0) then
  call read_network(netin)
else
  print *, 'no way to initialize'
end if

irec=count_records_in(filea)
allocate(pa(ima(0),irec),ta(ima(nl),irec))
if (irec > 0) call file_to_arrays(filea,pa,ta)

irec=count_records_in(fileb)
allocate(pb(ima(0),irec),tb(ima(nl),irec))
if (irec > 0) call file_to_arrays(fileb,pb,tb)

irec=count_records_in(filec)
allocate(pc(ima(0),irec),tc(ima(nl),irec))
if (irec > 0) call file_to_arrays(filec,pc,tc)

if (nread > 0) then ! begin training session
  open (unit=60,file='nn_mse.dat',status='unknown')
  irec=size(pa,2)
  print *,' training with ',trim(filea),'. will  read ',irec,&
' records, ',nread,' times.  please wait...'
  
  call cpu_time(time)
  print *,time
  !**********start training loop *************************
  ibatch=0
  allocate(ideck(irec))
  print *, irec
  call makedeck(ideck)
  do iread=1,nread
    call shuffledeck(ideck)
    !alpha=(alpha1*(nread-iread)+alpha2*(iread-1.))/(nread-1.)
    alpha=(alpha0-alphai)*exp(-1.*iread/nalpha)+alphai  
    
    do ii=1,irec
      p=pa(:,ideck(ii)) 
      t=ta(:,ideck(ii))
      ibatch=ibatch+1
      
      call forward_model(p)
      
      call backprop_sensitivities(t)
      
      if (verbose >= 3) then
        call forward_model(p)
        call sen_test(.01_mrl,1,2,1,t)
        stop
      end if

      if (nbatch>1) then ! usually not 
        
        ! accumulate network weights tendencies
        do m=nl,1,-1
          call point_layer(m)
          do iii=1,size(w,1)
          do jjj=1,size(w,2)
            w(iii,jjj)=w(iii,jjj)-alpha*s(iii)*am(jjj)
          enddo
          enddo
          db=db-alpha*s
        end do
        
        ! change weights after accumulating nbatch tendencies
        if (mod(ibatch,nbatch)==0) then
          do m=nl,1,-1
            call point_layer(m)
            dw=dw/nbatch
            db=db/nbatch
            w=w+dw
            b=b+db
            db=0._mrl
            dw=0._mrl
          end do
          ibatch=0
        end if

      else ! for nbatch=1 only, this is easier to understand: 
        do m=nl,1,-1
          call point_layer(m)
          do iii=1,size(w,1)
          do jjj=1,size(w,2)
            w(iii,jjj)=w(iii,jjj)-alpha*s(iii)*am(jjj)
          enddo
          enddo
          b=b-alpha*s
        end do
      end if
      
      
    end do
    if (iread == 2) then
      timel=time
      call cpu_time(time)
      time=nread*(time-timel)
      print *,' estimated time to finish is ',time,' seconds.'
    end if
    write (aline,'(i5,4es14.5)') iread,alpha,average_error(pa,ta),&
      average_error(pb,tb),average_error(pc,tc)
    print *,trim(aline)
    write (60,*) trim(aline)
    
  end do
  !**********end training loop***************************
  
  close (unit=60)
  
  print *,'this is the network that was found:'
  do m=1,nl
    call point_layer(m)
    print *,'layer ',m
    print *,' this is w:'
    call printmat(w)
    print *,' this is b:'
    call printcol(b)
  end do
  
  call write_network(netout)
  !**********end training session***************************
else
  print *,"No training.  Will run forward model only."
end if

if (size(pa,2)>0) then
  write (aline,'(es14.5)') average_error(pa,ta)
  write (bline,'(es14.5)') average_square_target(ta)
  print *, "mean square error with ",trim(filea),": ",trim(aline)
  call write_a_t(pa,ta,'nn_a.dat',trim(filea),&
   "nn prediction and target with "//trim(filea)//", mse="//trim(aline)//", mst="//trim(bline))
end if

if (size(pb,2)>0) then
  write (aline,'(es14.5)') average_error(pb,tb)
  write (bline,'(es14.5)') average_square_target(tb)
  print *, "mean square error with ",trim(fileb),": ",trim(aline)
  call write_a_t(pb,tb,'nn_b.dat',trim(fileb),&
   "nn prediction and target with "//trim(fileb)//", mse="//trim(aline)//", mst="//trim(bline))
end if

if (size(pc,2)>0) then
  write (aline,'(es14.5)') average_error(pc,tc)
  write (bline,'(es14.5)') average_square_target(tc)
  print *, "mean square error with ",trim(filec),": ",trim(aline)
  call write_a_t(pc,tc,'nn_c.dat',trim(filec),&
   "nn prediction and target with "//trim(filec)//", mse="//trim(aline)//", mst="//trim(bline))
end if

end program nn
