First commit of Runhai code by Emre

parents
# Sisso Image
A docker image using MPI to compile and run the sisso fortran code
docker build -t labdev-nomad.esc.rzg.mpg.de:5000/nomadlab/sisso-img:v1 sisso-img
FROM dispel4py/docker.openmpi
ADD . /src
This diff is collapsed.
This diff is collapsed.
program feature_descriptor
!----------------------------------------------------------------------------------
!Copyright 2017 Runhai Ouyang
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
!----------------------------------------------------------------------------------
!----------------------------------------------------------------------------------------------
! combining feature_construction and descriptor_identification to find descriptor automatically.
! Version FCDI.1.0, April, 2017
!-----------------------------------------------------------------------------------------------
use libms
implicit none
integer i,j,k,l,ll,m,ntask,ntask_1c,ntask_nc,subs_sis,ntmp,nsf,nvf,size_fs,space_size,desc_dim,ntask_tot,stat1,stat2
character line*1000000,descname*13 ,taskname*11,headline*1000000,linetmp*1000000,mpiname*50,ptype*10,method*10,&
iFCDI*5,nsample_line*500,task_arr*2
real*8 rtmp
character,allocatable:: itername(:)*6,string(:,:)*100
integer,allocatable:: nsample(:),ngroup(:,:)
real*8,allocatable:: res(:,:),trainy(:,:),feat(:,:),fit(:,:),atfeat(:,:)
logical dexist
nvf=0
! read FCDI.in
open(1,file='FCDI.in',status='old')
do
read(1,'(a)',iostat=stat1), line
if (stat1 /= 0) exit
i=index(line,'!')
if(i/=0) line(i:)=''
i=index(line,'=')
if(i>0) then
if(trim(adjustl(line(1:i-1)))=='mpiname') then
read(line(i+1:),*) mpiname
else if(trim(adjustl(line(1:i-1)))=='desc_dim') then
read(line(i+1:),*) desc_dim
else if(trim(adjustl(line(1:i-1)))=='nsf') then
read(line(i+1:),*) nsf
else if(trim(adjustl(line(1:i-1)))=='nvf') then
read(line(i+1:),*) nvf
else if(trim(adjustl(line(1:i-1)))=='ntask') then
read(line(i+1:),*) ntask_tot
else if(trim(adjustl(line(1:i-1)))=='task_arr') then
read(line(i+1:),*) task_arr
else if(trim(adjustl(line(1:i-1)))=='nsample') then
read(line(i+1:),'(a)') nsample_line
else if(trim(adjustl(line(1:i-1)))=='subs_sis') then
read(line(i+1:),*) subs_sis
else if(trim(adjustl(line(1:i-1)))=='ptype') then
read(line(i+1:),*) ptype
else if(trim(adjustl(line(1:i-1)))=='method') then
read(line(i+1:),*) method
end if
end if
end do
close(1)
ntask_1c=1
ntask_nc=1
if(task_arr=='1c') then
ntask_1c=ntask_tot
else if(task_arr=='nc') then
ntask_nc=ntask_tot
end if
allocate(nsample(ntask_1c)) ! total samples for each task
allocate(ngroup(ntask_1c,1000)) ! (for classification) number of samples for each of the groups in each task
nsample=0
ngroup=0
if(trim(adjustl(ptype))=='quanti') then
read(nsample_line,*) nsample
else ! classification
do ll=1,ntask_1c
i=index(nsample_line,'(')
j=index(nsample_line,')')
l=0
do k=i,j
if(nsample_line(k:k)==',') l=l+1
end do
read(nsample_line(i+1:j-1),*) ngroup(ll,1:l+1)
ngroup(ll,1000)=l+1
nsample(ll)=sum(ngroup(ll,1:l+1))
nsample_line(:j)=''
end do
end if
allocate(itername(desc_dim))
itername(:)(1:4)='iter'
do i=1,desc_dim
write(itername(i)(5:6),'(i2.2)') i
end do
descname(1:4)='desc'
taskname(1:4)='task'
! major array allocation
allocate(trainy(sum(nsample),ntask_nc))
allocate(res(sum(nsample),ntask_nc))
allocate(fit(sum(nsample),ntask_nc))
allocate(atfeat(sum(nsample),nsf))
allocate(feat(sum(nsample),subs_sis*desc_dim))
allocate(string(sum(nsample),2))
ntask=ntask_nc*ntask_1c
! get property data and the basic scalar features
open(1,file='train.dat',status='old')
read(1,'(a)') headline
do i=1,sum(nsample)
read(1,'(a)') line
call string_split(line,string(i,:),' ')
k=index(line,trim(adjustl(string(i,2))))
if(trim(adjustl(ptype))=='quanti') then
read(line(k:),*) trainy(i,:),atfeat(i,:)
else
read(line(k:),*) atfeat(i,:)
end if
end do
close(1)
! iteration starts ...
do i=1,desc_dim
! inquire(directory=itername(i),exist=dexist)
! if(dexist) cycle
write(*,'(/a,i3)') 'iteration: ',i
! cp files for this iter
call system('rm -rf '//itername(i)//'; mkdir '//itername(i)//'; cp FCDI.in train.dat '//itername(i)//'')
if(nvf>0) call system('cp train_vf.dat '//itername(i)//'')
write(iFCDI,'(i5)') i
call system('cd '//itername(i)//'; echo '//iFCDI//' >iFCDI')
! revise DI.in for this iter
open(1,file=itername(i)//'/FCDI.in',status='old')
open(2,file=itername(i)//'/FCDI.in_new',status='replace')
size_fs=i*subs_sis
do
read(1,'(a)',iostat=stat2), line
if (stat2 /= 0) exit
linetmp=line
j=index(linetmp,'!')
if(j/=0) linetmp(j:)=''
j=index(linetmp,'=')
if(j>0) then
if(trim(adjustl(linetmp(1:j-1)))=='size_fs') then
line(:8)='size_fs='
write(line(9:),'(i8,a)') size_fs,' !automatically modified by FCDI during the run'
else if(trim(adjustl(linetmp(1:j-1)))=='nfL0') then
if(trim(adjustl(method))=='L0') then
line(:5)='nfL0='
write(line(6:),'(i8,a)') size_fs,' !automatically modified by FCDI during the run'
end if
end if
end if
write(2,'(a)') trim(line)
end do
close(1)
close(2)
call system('cd '//itername(i)//'; mv FCDI.in_new FCDI.in')
if(i==1) then ! run for the first iteration
! run FC and DI
write(*,'(a)') 'FC starts ...'
call system('cd '//itername(i)//'; '//trim(adjustl(mpiname))//' FC')
write(*,'(a)') 'FC done!'
write(*,'(/a)') 'DI starts ...'
call system('cd '//itername(i)//'; '//trim(adjustl(mpiname))//' DI')
write(*,'(a/)') 'DI done!'
else ! oter iteration
! revise train.dat for this iter
m=0
do j=1,ntask_nc
do k=1,ntask_1c
m=m+1 ! the task number
write(descname(5:5),'(i1.1)') i-1
write(descname(6:6),'(a)') '_'
write(descname(7:9),'(i3.3)') m
write(descname(10:13),'(a)') '.dat'
open(1,file=itername(i-1)//'/desc_dat/'//descname,status='old')
read(1,*)
do l=1,nsample(k)
read(1,'(a)') line
read(line,*) ntmp,rtmp,fit(sum(nsample(:k-1))+l,j)
end do
close(1)
end do
end do
if (trim(adjustl(ptype))=='quanti') res=trainy-fit
open(1,file=itername(i)//'/train.dat',status='replace')
write(1,'(a)') trim(headline)
if(trim(adjustl(ptype))=='quanti') then
1001 format(a15,*(e15.5))
do j=1,sum(nsample)
write(1,1001) trim(adjustl(string(j,1))),res(j,:),atfeat(j,:)
end do
else
1002 format(a15,*(e15.5))
do j=1,sum(nsample)
write(1,1002) trim(adjustl(string(j,1))),atfeat(j,:)
end do
end if
close(1)
! run FC
write(*,'(a)') 'FC starts ...'
call system('cd '//itername(i)//'; cp ../'//itername(i-1)//'/task.fname ./reject.name; &
'//trim(adjustl(mpiname))//' FC; mv task.fname this.fname')
! cp ../train.dat ./y0.dat; '//trim(adjustl(mpiname))//' FC; mv task.fname this.fname')
write(*,'(a)') 'FC done!'
write(*,'(/a)') 'DI starts ...'
! revise task data for DI run
call system(' cd '//itername(i)//'; cp ../'//itername(i-1)//'/task.fname .; cat this.fname>>task.fname')
m=0
do j=1,ntask_nc
do k=1,ntask_1c
m=m+1
write(taskname(5:7),'(i3.3)') m
write(taskname(8:11),'(a)') '.dat'
open(1,file=itername(i-1)//'/'//taskname,status='old')
! read in feat data of i-1 iteration
if(trim(adjustl(ptype))=='quanti') then
do l=1,nsample(k)
read(1,*) rtmp,feat(sum(nsample(:k-1))+l,:(i-1)*subs_sis)
end do
else
do l=1,nsample(k)
read(1,*) feat(sum(nsample(:k-1))+l,:(i-1)*subs_sis)
end do
end if
close(1)
! read in feat data of this iteration
open(1,file=itername(i)//'/'//taskname,status='old')
if(trim(adjustl(ptype))=='quanti') then
do l=1,nsample(k)
read(1,*) rtmp,feat(sum(nsample(:k-1))+l,(i-1)*subs_sis+1:i*subs_sis)
end do
else
do l=1,nsample(k)
read(1,*) feat(sum(nsample(:k-1))+l,(i-1)*subs_sis+1:i*subs_sis)
end do
end if
close(1)
! new taskxxx.dat
open(1,file=itername(i)//'/'//taskname,status='replace')
if(trim(adjustl(ptype))=='quanti') then
1003 format(*(e15.5))
do l=1,nsample(k)
write(1,1003) trainy(sum(nsample(:k-1))+l,j),feat(sum(nsample(:k-1))+l,:subs_sis*i)
end do
else
1004 format(*(e15.5))
do l=1,nsample(k)
write(1,1004) feat(sum(nsample(:k-1))+l,:subs_sis*i)
end do
end if
close(1)
end do
end do
! run DI
call system('cd '//itername(i)//'; '//trim(adjustl(mpiname))//' DI')
write(*,'(a/)') 'DI done!'
end if
end do
deallocate(itername)
deallocate(nsample)
deallocate(ngroup)
deallocate(trainy)
deallocate(res)
deallocate(fit)
deallocate(atfeat)
deallocate(feat)
deallocate(string)
end program
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment