text:
!!--------- Use suitable routine to read in the file, infomode=0/1 show/don't show info
subroutine readinfile(thisfilename,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) thisfilename
character fchname*200,moldenname*200,c80tmp*20,filenameonly*200
integer infomode,inamelen

call path2filename(thisfilename,filenameonly) !Remove folder part

iresinfo=0 !First assume residue information is not available from input file (but will set to 1 in the subroutine of loading pdb/pqr/gro)

inamelen=len_trim(thisfilename)
if (infomode==0) write(*,*) "Please wait..."
if (thisfilename(inamelen-2:inamelen)=="fch".or.thisfilename(inamelen-3:inamelen)=="fchk"&
.or.thisfilename(inamelen-3:inamelen)=="FCH".or.thisfilename(inamelen-3:inamelen)=="FChk"&
.or.thisfilename(inamelen-3:inamelen)=="FCHK") then
	call readfch(thisfilename,infomode)
else if (thisfilename(inamelen-3:inamelen)=="mwfn") then
    call readmwfn(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="wfn".or.thisfilename(inamelen-2:inamelen)=="WFN") then
	call readwfn(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="wfx".or.thisfilename(inamelen-2:inamelen)=="WFX") then
	call readwfx(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="chg".or.thisfilename(inamelen-2:inamelen)=="CHG") then
	call readchg(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="pqr".or.thisfilename(inamelen-2:inamelen)=="PQR") then
	call readpdb_pqr(thisfilename,infomode,1)
else if (thisfilename(inamelen-2:inamelen)=="pdb".or.thisfilename(inamelen-2:inamelen)=="PDB") then
	call readpdb_pqr(thisfilename,infomode,0)
else if (thisfilename(inamelen-2:inamelen)=="xyz".or.thisfilename(inamelen-2:inamelen)=="XYZ") then
	call readxyz(thisfilename,infomode,1)
else if (thisfilename(inamelen-1:inamelen)=="31") then
	call read31(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="grd") then
	call readgrd(thisfilename,infomode,0)
else if (thisfilename(inamelen-2:inamelen)=="vti") then
	call readvti(thisfilename,infomode,0)
else if (thisfilename(inamelen-1:inamelen)=="dx") then
	call readdx(thisfilename,infomode,0)
else if (thisfilename(inamelen-2:inamelen)=="gro") then
	call readgro(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="cub".or.thisfilename(inamelen-3:inamelen)=="cube") then
	call readcube(thisfilename,infomode,0)
else if (thisfilename(inamelen-2:inamelen)=="gms") then
	call readgms(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="mol") then
	call readmol(thisfilename,infomode)
else if (thisfilename(inamelen-3:inamelen)=="mol2") then
	call readmol2(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="gjf".or.thisfilename(inamelen-2:inamelen)=="com") then
	call readgjf(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="cif") then
	call readcif(thisfilename,infomode)
else if (index(thisfilename,".molden")/=0.or.index(thisfilename,".molden.input")/=0.or.index(thisfilename,"molden.inp")/=0.or.filenameonly=="MOLDEN") then
	!ORCA uses .molden.input as suffix, Dalton uses molden.inp
	call readmolden(thisfilename,infomode)
else if (thisfilename(inamelen-2:inamelen)=="chk") then
	if (formchkpath==" ") then
		write(*,"(a)") " Error: .chk file is not directly supported. You should use formchk to convert it to fch/fchk before loading. &
		Alternatively, you can set ""formchkpath"" parameter in settings.ini to actual path, so that Multiwfn can directly open .chk file"
		write(*,*) "Press ENTER button to exit"
		read(*,*)
		stop
	end if
	inquire(file=formchkpath,exist=alive)
	if (alive==.false.) then
		write(*,"(a)") " Note: Albeit ""formchkpath"" parameter in settings.ini has been defined, &
		the formchk executable file cannot be located, therefore the .chk file cannot be directly opened by Multiwfn"
		write(*,*) "Press ENTER button to exit"
		read(*,*)
		stop
	else
        fchname=thisfilename
		call chk2fch(fchname)
		inquire(file=fchname,exist=alive)
		if (alive) then
            !Check file content, conversion failure may also result in file, but the content is empty
            open(10,file=fchname,status="old")
            read(10,"(a)",iostat=ierror) c80tmp
            close(10)
            if (c80tmp==" ".or.ierror/=0) then
			    write(*,*) "Error: formchk conversion failed!"
			    write(*,*) "Press ENTER button to exit"
			    read(*,*)
			    stop
            end if
			call readfch(fchname,infomode)
			call delfile(fchname)
		else
			write(*,*) "Error: formchk conversion failed!"
			write(*,*) "Press ENTER button to exit"
			read(*,*)
			stop
		end if
	end if
else if (thisfilename(inamelen-2:inamelen)=="gbw") then
	if (orca_2mklpath==" ") then
		write(*,"(a)") " Error: .gbw file is not directly supported. You should use orca_2mkl to convert it to .molden before loading. &
		Alternatively, you can set ""orca_2mklpath"" parameter in settings.ini to actual path, so that Multiwfn can directly open .gbw file"
		write(*,*) "Press ENTER button to exit"
		read(*,*)
		stop
	end if
	inquire(file=orca_2mklpath,exist=alive)
	if (alive==.false.) then
		write(*,"(a)") " Note: Albeit ""orca_2mklpath"" parameter in settings.ini has been defined, &
		the orca_2mkl executable file cannot be located, therefore the .gbw file cannot be directly opened by Multiwfn"
		write(*,*) "Press ENTER button to exit"
		read(*,*)
		stop
	else
        moldenname=thisfilename
		call gbw2molden(moldenname)
		inquire(file=moldenname,exist=alive)
		if (alive) then
			call readmolden(moldenname,infomode)
			call delfile(moldenname)
		else
			write(*,*) "Error: orca_2mkl conversion failed!"
			write(*,*) "Press ENTER button to exit"
			read(*,*)
			stop
		end if
	end if
else if (index(filenameonly,"POSCAR")/=0) then
    call readPOSCAR(thisfilename,infomode)
else if (index(filenameonly,"CHGCAR")/=0.or.index(filenameonly,"CHG")/=0.or.index(filenameonly,"ELFCAR")/=0.or.index(filenameonly,"LOCPOT")/=0) then
    call readVASPgrd(thisfilename,infomode)
else !Plain text file
	ifiletype=0
    !Try to load as output file of a code
    open(10,file=thisfilename,status="old")
    call outputprog(10,iprog)
    close(10)
    if (iprog==1) then
        call loadGauout(10,thisfilename)
    else if (iprog==2) then
        call loadORCAout(10,thisfilename)
    end if
    !Try to load as input file of a code
    if (iprog==0) then
        open(10,file=thisfilename,status="old")
        call inputprog(10,iprog)
        close(10)
        if (iprog==1) then
            if (thisfilename(inamelen-2:inamelen)=="inp".or.thisfilename(inamelen-6:inamelen)=="restart") call readcp2k(thisfilename,infomode)
        else if (iprog==2) then
            call readORCAinp(thisfilename,infomode)
        end if
    end if
    !Try to load as Turobmole input file ($coord in the first line)
    open(10,file=thisfilename,status="old")
    read(10,"(a)") c80tmp
    close(10)
    if (index(c80tmp,"$coord")/=0) then
        write(*,"(a)") " Loading the file as coordinate file of Turbomole since the first line is ""$coord"""
        call readTurbomole(thisfilename,infomode)
    end if
end if

if (iresinfo==0) then !Residue information was not loaded, initialize empty content
    a%resid=1
    a%resname=" "
end if

!Determine how to supply EDF information for the file containing GTF information when pseudopotential basis set is involved
!For .wfn file, EDF has already been added in due case in subroutine readwfn, and EDF may has been added in subroutine readwfx if EDF is available in the file and readEDF==1
if (allocated(b)) then
	if (any(a%index/=nint(a%charge)) .and..not.allocated(b_EDF)) then
		if (isupplyEDF==0) then !Do nothing
			continue
		else if (isupplyEDF==1) then !Supply EDF from .wfx file
			call readEDFatmwfx
		else if (isupplyEDF==2) then !Supply EDF from bulit-in library
			call readEDFlib(infomode)
		end if
	end if
end if

call genfragatm !Generate fragatm array containing all atoms

call init_PBC !Initialize some PBC information and settings

!Current Multiwfn only initializes LIBRETA when ESP is to be calculated, so below codes are commented
!if (if_initlibreta==0) then
!    write(*,*) "Initializing LIBRETA library for ESP evaluation, please wait..."
!    call initlibreta()
!    if_initlibreta=1 !Global variable
!end if
end subroutine

!!------ Assume ifileid is a Gaussian output file, when iloadGaugeom>0, then load the final geometry as well number of electrons
!iloadGaugeom=1: First try to load input orientation, if it is not found, load standard orientation instead
!iloadGaugeom=2: Load standard orientation
subroutine loadGauout(ifileid,gaufilename)
use defvar
use util
implicit real*8 (a-h,o-z)
character gaufilename*200,c80tmp*80,locstr*40
open(ifileid,file=gaufilename,status="old")
if (iloadGaugeom>0) then
    write(*,*) "Trying to load geometry from this file..."
    do itime=1,2
        if (iloadGaugeom==2.and.itime==1) cycle
        if (itime==1) then
            locstr="Input orientation:"
        else if (itime==2) then
            locstr="Standard orientation:"
        end if
        nskip=0
        do while(.true.) !Find the final geometry. nskip is the number of labels to be skipped
            call loclabel(ifileid,locstr,ifound,0)
            if (ifound==0) exit
            nskip=nskip+1
            read(ifileid,*)
        end do
        if (nskip>0) then !Found at least once
            call loclabel(ifileid,locstr,ifound)
            call skiplines(ifileid,5)
            ncenter=0
            do while(.true.)
                read(ifileid,"(a)") c80tmp
                if (index(c80tmp,"----")/=0) exit
                ncenter=ncenter+1
            end do
            if (allocated(a)) deallocate(a)
            allocate(a(ncenter))
            rewind(ifileid)
            do iload=1,nskip
                call loclabel(ifileid,locstr,ifound,0)
                read(ifileid,*)
            end do
            call skiplines(ifileid,4)
            do iatm=1,ncenter
                read(ifileid,*) inouse,a(iatm)%index,inouse,a(iatm)%x,a(iatm)%y,a(iatm)%z
                a(iatm)%name=ind2name(a(iatm)%index)
            end do
            a%charge=a%index !Incompatible with ECP case
            a%x=a%x/b2a
            a%y=a%y/b2a
            a%z=a%z/b2a
            if (itime==1) write(*,*) "Geometry (final, input orientation) has been loaded from this file"
            if (itime==2) write(*,*) "Geometry (final, standard orientation) has been loaded from this file"
            exit
        else
            if (itime==1) then
                write(*,"(a)") " Note: Unable to load geometry in input orientation, trying to load geometry in standard orientation instead"
                rewind(ifileid)
            else if (itime==2) then
                write(*,*) "Warning: Failed to load geometry in standard orientation from this file"
            end if
        end if
    end do
    !Load electrons
    call loclabel(ifileid," alpha electrons")
    read(ifileid,"(a)") c80tmp
    read(c80tmp,*) naelec
    read(c80tmp(24:),*) nbelec
    nelec=naelec+nbelec
    write(*,"(a,3i8)") " Number of alpha/beta/total electrons:",nint(naelec),nint(nbelec),nint(nelec)
    !Load net charge and spin multiplicity, so that when save to gjf they will be identical to output file
    call loclabel(ifileid," Multiplicity =",ifound)
    if (ifound==1) then
        read(ifileid,"(a)") c80tmp
        ieqs=index(c80tmp,'=')
        read(c80tmp(ieqs+1:),*) loadcharge
        ieqs=index(c80tmp,'=',back=.true.)
        read(c80tmp(ieqs+1:),*) loadmulti
    end if
else
    write(*,"(a)") " Note: This file seems to be a Gaussian output file. If you set ""iloadGaugeom"" in settings.ini to 1, &
    then Multiwfn will load geometry (final, input orientation) as well as number of electrons from this file"
end if
close(ifileid)
end subroutine

!!------ Assume ifileid is a ORCA output file, when iloadORCAgeom=1, then load the final geometry as well number of electrons
subroutine loadORCAout(ifileid,ORCAfilename)
use defvar
use util
implicit real*8 (a-h,o-z)
character ORCAfilename*200,c80tmp*80
character :: locstr*40="CARTESIAN COORDINATES (ANGSTROEM)"

open(ifileid,file=ORCAfilename,status="old")
if (iloadORCAgeom>0) then
    write(*,*) "Trying to load geometry from this file..."
    nfound=0
    do while(.true.) !Find the final geometry. nskip is the number of labels to be skipped
        call loclabel(ifileid,locstr,ifound,0)
        if (ifound==0) exit
        nfound=nfound+1
        read(ifileid,*)
    end do
    if (nfound>0) then !Found at least once
        call loclabel(ifileid,locstr,ifound)
        call skiplines(ifileid,2)
        ncenter=0
        do while(.true.)
            read(ifileid,"(a)") c80tmp
            if (c80tmp==" ") exit
            ncenter=ncenter+1
        end do
        if (allocated(a)) deallocate(a)
        allocate(a(ncenter))
        rewind(ifileid)
        do iload=1,nfound-1
            call loclabel(ifileid,locstr,ifound,0)
            read(ifileid,*)
        end do
        call loclabel(ifileid,locstr,ifound,0)
        call skiplines(ifileid,2)
        do iatm=1,ncenter
            read(ifileid,*) a(iatm)%name,a(iatm)%x,a(iatm)%y,a(iatm)%z
	        call lc2uc(a(iatm)%name(1:1)) !Convert to upper case
	        call uc2lc(a(iatm)%name(2:2)) !Convert to lower case
	        do iele=0,nelesupp
		        if ( a(iatm)%name==ind2name(iele) ) then
			        a(iatm)%index=iele
			        exit
		        end if
	        end do
        end do
        a%charge=a%index !Incompatible with ECP case
        a%x=a%x/b2a
        a%y=a%y/b2a
        a%z=a%z/b2a
        write(*,*) "Geometry (final) has been loaded from this file"
    else
        write(*,"(a)") " Warning: Failed to load geometry from this file, """//trim(locstr)//""" field cannot be located"
    end if
else
    write(*,"(a)") " Note: This file seems to be an ORCA output file. If you set ""iloadORCAgeom"" in settings.ini to 1, &
    then Multiwfn will load (final) geometry as well as number of electrons from this file"
end if
close(ifileid)
end subroutine

!!-------- Convert inputted chk file to fch/fchk via formchk, return the path of generated (may be failed) .fch/fchk file
subroutine chk2fch(fchname)
use defvar
implicit real*8 (a-h,o-z)
character*200 fchname,c500tmp,fchnamenew
itmp=index(fchname,'.',back=.true.)
if (isys==1) then
    fchnamenew=fchname(:itmp)//"fch"
	c500tmp=trim(formchkpath)//' "'//trim(fchname)//'" "'//trim(fchnamenew)//'" > NUL'
else
    fchnamenew=fchname(:itmp)//"fchk"
	c500tmp=trim(formchkpath)//' "'//trim(fchname)//'" "'//trim(fchnamenew)//'" > /dev/null'
end if
write(*,"(a)") " Running: "//trim(c500tmp)
call system(trim(c500tmp))
fchname=fchnamenew
end subroutine

!!-------- Convert gbw to molden via orca_2mkl, return the path of generated (may be failed) .molden file
subroutine gbw2molden(gbwname)
use defvar
implicit real*8 (a-h,o-z)
character*200 gbwname,c200tmp
inamelen=len_trim(gbwname)
ico=index(gbwname,'.',back=.true.)
if (isys==1) then
	c200tmp=trim(orca_2mklpath)//' "'//trim(gbwname(:ico-1))//'" -molden > NUL'
else
	c200tmp=trim(orca_2mklpath)//' "'//trim(gbwname(:ico-1))//'" -molden > /dev/null'
end if
write(*,"(a)") " Running: "//trim(c200tmp)
call system(trim(c200tmp))
gbwname=trim(gbwname(:ico))//"molden.input"
end subroutine

!!-----------------------------------------------------------------
!!------------------------- Read Gaussian formatted check file
!Some temporary arrays, including shelltype, shell2atom, shellcon, primexp, concoeff will be stored to corresponding global arrays after some revisions
!infomode=0 means output info, =1 silent
subroutine readfch(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) name
character selectyn,c80*80,fchtitle*79,levelstr*80
integer,allocatable :: shelltype(:),shell2atom(:),shellcon(:) !Degree of shell contraction
integer,allocatable :: tmparrint(:)
real*8,allocatable :: primexp(:),concoeff(:),SPconcoeff(:),amocoeff(:,:),bmocoeff(:,:),tmpmat(:,:),tmparr(:)
integer :: s2f(-5:5,21)=0 !Give shell type & orbital index to get functype
real*8 conv5d6d(6,5),conv7f10f(10,7),conv9g15g(15,9),conv11h21h(21,11)
!For backing up spherical basis functions
integer,allocatable :: shelltype5D(:),MOtype5D(:)
real*8,allocatable :: CObasa5D(:,:),CObasb5D(:,:),MOocc5D(:),MOene5D(:),CO5D(:,:)
integer,allocatable :: shelltype6D(:) !Temporarily store Cartesian shell types containing SP shell
real*8,external :: normgau
ifiletype=1
imodwfn=0
s2f(-5,1:11)=(/ -32,-31,-30,-29,-28,-27,-26,-25,-24,-23,-22 /)
s2f(-4,1:9)=(/ -21,-20,-19,-18,-17,-16,-15,-14,-13 /)
s2f(-3,1:7)=(/ -12,-11,-10,-9,-8,-7,-6 /)
s2f(-2,1:5)=(/ -5,-4,-3,-2,-1 /)
s2f(-1,1:4)=(/ 1,2,3,4 /)
s2f(0,1)=1
s2f(1,1:3)=(/ 2,3,4 /)
s2f(2,1:6)=(/ 5,6,7,8,9,10 /)
s2f(3,1:10)=(/ 11,12,13,17,14,15,18,19,16,20 /) !Note: The sequence of f functions in Multiwfn is not identical to .fch, so convert here. While spdgh are identical
s2f(4,1:15)=(/ 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35 /)
s2f(5,1:21)=(/ 36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56 /)
call gensphcartab(1,conv5d6d,conv7f10f,conv9g15g,conv11h21h)

open(10,file=name,status="old")
read(10,"(a)") fchtitle
if (infomode==0) write(*,*) "Loading various information of the wavefunction"
isaveNO=0
isaveNBOocc=0
isaveNBOene=0
if (index(fchtitle,'saveNBOocc')/=0.or.index(fchtitle,'SaveNBOocc')/=0) isaveNBOocc=1
if (index(fchtitle,'saveNBOene')/=0.or.index(fchtitle,'SaveNBOene')/=0) isaveNBOene=1
if (index(fchtitle,'saveNO')/=0.or.index(fchtitle,'SaveNO')/=0) isaveNO=1
if ((isaveNBOocc==1.or.isaveNBOene==1).and.infomode==0) write(*,*) "The file contains NBO information"
if (isaveNO==1.and.infomode==0) write(*,*) "The file contains natural orbitals information"
read(10,"(a)") levelstr
if (index(levelstr,"  ZDO")/=0) then
    write(*,"(/,a)") " Warning: It seems that this fch file comes from semi-empirical calculation, the wavefunction generated using this kind of method &
    is not supported by Multiwfn, all wavefunction analysis results will be meaningless!"
    write(*,"(a)") " Hint: If you want to use Multiwfn to perform wavefunction analysis &
    at a level as cheap as semi-empirical methods, you may consider to use xtb code to conduct GFN-xTB calculation, the .molden file generated by xtb is supported by Multiwfn"
    write(*,*) "Press ENTER button to continue"
    read(*,*)
end if
if (levelstr(11:11)=="R") wfntype=0
if (levelstr(11:11)=="U") wfntype=1
if (levelstr(11:12)=="RO") then
    wfntype=2
    if (levelstr(13:13)=='3') wfntype=0 !RO3LYP means R form of O3LYP
end if
call loclabel(10,'Number of electrons')
read(10,"(49x,f12.0)") nelec
read(10,"(49x,f12.0)") naelec
read(10,"(49x,f12.0)") nbelec
if (naelec/=nbelec.and.wfntype==0) wfntype=1 !This is often redundant, but considering that sometimes U is not properly recognized, this maybe useful
if (index(levelstr,"CASSCF")/=0.and.naelec/=nbelec.and.isaveNO/=1) then !Suitable for CASSCF calculation of spin multiplicity >1
    wfntype=2
    write(*,"(a)") " This is a CASSCF wavefunction with spin multiplicity >1, &
    and pseudo-canonical orbitals are recorded, the current wavefunction is treated as ROHF"
end if
if (isaveNBOocc==1.or.isaveNBOene==1.or.isaveNO==1) then
	if (wfntype==0) wfntype=3
	if (wfntype==1) wfntype=4
end if

call loclabel(10,'Number of basis functions')
read(10,"(49x,i12)") nbasis
nindbasis=nbasis
call loclabel(10,'Number of independent functions',ifound) !G09
if (ifound==0) call loclabel(10,'Number of independant functions',ifound) !G03
if (ifound==1) read(10,"(49x,i12)") nindbasis !Number of linear independant functions
call loclabel(10,'Number of translation vectors',ifound,maxline=1000) !G09
if (ifound==1) read(10,"(49x,i12)") ifPBC
virialratio=2D0
call loclabel(10,'Virial Ratio',ifound)
if (ifound==1) read(10,"(49x,1PE22.15)") virialratio
totenergy=0D0
call loclabel(10,'Total Energy',ifound) !if no this entry, loclabel return ifound=0, else =1
if (ifound==1) read(10,"(49x,1PE22.15)") totenergy
call loclabel(10,'Atomic numbers')
read(10,"(49x,i12)") ncenter
allocate(tmparrint(ncenter))
read(10,"(6i12)") tmparrint
if (any(tmparrint==0).and.infomode==0) then
	write(*,*)
	write(*,*) "Ghost atoms (Bq) are found in this file. Do you want to load them? (y/n)"
	write(*,"(a)") " Note: If all Bq atoms have corresponding basis functions, then they can be safely loaded. &
	However, if some of them do not have basis functions, in general they should not be loaded, otherwise problems or crashes may occur &
	when performing analyses based on wavefunction"
	read(*,*) selectyn
	if (selectyn=='n'.or.selectyn=='N') ncenter=count(tmparrint/=0)
end if
if (allocated(a)) deallocate(a)
allocate(a(ncenter))
a%index=tmparrint(1:ncenter)
a%name=ind2name(a%index)
call loclabel(10,'Nuclear charges') !If ECP was used, nuclear charge /= atomic number
read(10,*)
read(10,"(5(1PE16.8))") (a(i)%charge,i=1,ncenter)
call loclabel(10,'Current cartesian coordinates')
read(10,*)
read(10,"(5(1PE16.8))") (a(i)%x,a(i)%y,a(i)%z,i=1,ncenter)
if (ifPBC>0) then
    call loclabel(10,'Translation vectors')
    read(10,*)
    if (ifPBC==1) read(10,*) cellv1(:)
    if (ifPBC==2) read(10,*) cellv1(:),cellv2(:)
    if (ifPBC==3) read(10,*) cellv1(:),cellv2(:),cellv3(:)
end if
call loclabel(10,'Shell types')
read(10,"(49x,i12)") nshell
allocate(shelltype(nshell))
read(10,"(6i12)") (shelltype(i),i=1,nshell)

!Note that Multiwfn allows Cartesian and spherical harmonic basis functions mixed together. If any basis function is spherical harmonic type, then isphergau=1.
!Only the spherical harmonic ones will be treated specially
if (infomode==0) write(*,"(' The highest angular moment basis functions is ',a)") shtype2name(maxval(abs(shelltype)))
isphergau=0
if (any(shelltype<=-2)) isphergau=1
if (any(abs(shelltype)>5).and.infomode==0) then
	write(*,"(a)") " Error: GTFs with angular moment higher than h are found, while Multiwfn currently only supports up to h. Press Enter button to exit"
	read(*,*)
	stop
end if

if (infomode==0) write(*,*) "Loading basis set definition..."
call loclabel(10,'Number of primitives per shell')
read(10,*)
allocate(shellcon(nshell))
read(10,"(6i12)") (shellcon(i),i=1,nshell)
call loclabel(10,'Shell to atom map')
read(10,*)
allocate(shell2atom(nshell))
read(10,"(6i12)") (shell2atom(i),i=1,nshell)
call loclabel(10,'Primitive exponents')
read(10,"(49x,i12)") nprimshell
allocate(primexp(nprimshell))
read(10,"(5(1PE16.8))") (primexp(i),i=1,nprimshell)
call loclabel(10,'Contraction coefficients')
read(10,*)
allocate(concoeff(nprimshell))
read(10,"(5(1PE16.8))") (concoeff(i),i=1,nprimshell)
read(10,"(a)") c80
if (index(c80,"P(S=P) Contraction coefficients")/=0) then
	backspace(10)
	read(10,*)
	allocate(SPconcoeff(nprimshell))
	read(10,"(5(1PE16.8))") (SPconcoeff(i),i=1,nprimshell)
end if

if (infomode==0) write(*,*) "Loading orbitals..."
!Note: Some basis maybe removed by linear dependence checking, hence the number of orbitals in .fch may less than nbasis(always equals to nmo in Multiwfn)
!Hence when reading information involving the number of orbitals in .fch, use nindbasis instead nmo
!The expansion coefficients, energies in those undefined orbitals are all set to zero
if (wfntype==0.or.wfntype==2.or.wfntype==3) then !Restricted/restricted open-shell, saveNO/NBO
	nmo=nbasis
	allocate(MOene(nmo))
	allocate(MOocc(nmo))
	allocate(MOtype(nmo))
	allocate(amocoeff(nmo,nbasis))
	MOtype=0
	MOocc=0D0
	MOene=0D0
	amocoeff=0D0
	if (wfntype==0.or.wfntype==3) then
		MOocc(1:nint(nelec/2))=2.0D0
	else if (wfntype==2) then
		MOocc(1:nbelec)=2.0D0  !Alpha electrons is always more than beta counterpart
		MOocc(nbelec+1:naelec)=1D0
		MOtype(nbelec+1:naelec)=1
	end if
	call loclabel(10,'Alpha Orbital Energies',ifound)
	if (ifound==0) call loclabel(10,'orbital energies',ifound) !PSI4 since 1.2 uses "orbital energies" for closed-shell cases
    if (ifound==0) then
        write(*,"(a)") " Error: Unable to find orbital information from your input file! If the file was produced by ONIOM calculation, &
        note that the file cannot be used since this task does not store orbitals into the file"
        write(*,*) "Press ENTER button to exit"
        read(*,*)
        stop
    end if
	read(10,*)
	read(10,"(5(1PE16.8))") (MOene(i),i=1,nindbasis)
	call loclabel(10,'Alpha MO coefficients',ifound)
	if (ifound==0) call loclabel(10,'MO coefficients') !PSI4 since 1.2 uses "MO coefficients" for closed-shell cases
	read(10,*)
	read(10,"(5(1PE16.8))") ((amocoeff(imo,ibasis),ibasis=1,nbasis),imo=1,nindbasis)
else if (wfntype==1.or.wfntype==4) then !Unrestricted single-determinant or multiconfiguration wavefunction
	!Note that PSI4 since 1.2 uses lower case, this has been taken into account
	nmo=2*nbasis
	allocate(MOene(nmo))
	allocate(MOocc(nmo))
	allocate(MOtype(nmo))
	allocate(amocoeff(nbasis,nbasis))
	allocate(bmocoeff(nbasis,nbasis))
	MOocc=0D0
	MOocc(1:naelec)=1D0
	MOocc(nbasis+1:nbasis+nbelec)=1D0
	MOtype(1:nbasis)=1
	MOtype(nbasis+1:nmo)=2
	MOene=0D0
	amocoeff=0D0
	bmocoeff=0D0
	call loclabel(10,'Alpha Orbital Energies',ifound)
	if (ifound==0) call loclabel(10,'alpha orbital energies') !For PSI4
	read(10,*)
	read(10,"(5(1PE16.8))") (MOene(i),i=1,nindbasis)
	call loclabel(10,'Beta Orbital Energies',ifound)
	if (ifound==0) call loclabel(10,'beta orbital energies',ifound) !For PSI4
	if (ifound==0) then
		write(*,*) "Error: Beta orbital information was not found but expected!"
		write(*,*) "Press ENTER button to exit"
		read(*,*)
		stop
	end if
	read(10,*)
	read(10,"(5(1PE16.8))") (MOene(i),i=nbasis+1,nbasis+nindbasis)

	call loclabel(10,'lpha MO coefficients') !Compatible with PSI4
	read(10,*)
	read(10,"(5(1PE16.8))") ((amocoeff(imo,ibasis),ibasis=1,nbasis),imo=1,nindbasis)
	call loclabel(10,'eta MO coefficients') !Compatible with PSI4
	read(10,*)
	read(10,"(5(1PE16.8))") ((bmocoeff(imo,ibasis),ibasis=1,nbasis),imo=1,nindbasis)
end if

if (isaveNBOocc==1.or.isaveNO==1) then
	MOocc=MOene
	MOene=0.0D0
end if
if (isaveNBOene==1) MOocc=0.0D0 !For saveNBO, the automatically determined occupation number is meaningless
where (MOocc==1000) MOocc=0.0D0 !When saveNBO is used, the latest several occupation/energy of NBO are 1000, we modify them to zero
where (MOene==1000) MOene=0.0D0

close(10)

!!!!!! Reading have finished, now generate basis information

!Backup spherical basis information (some of them may be Cartesian ones) with 5D suffix (of course, may be actually 7f, 9g, 11h...),
!convert them to Cartesian type temporarily, at final stage recover them back
if (isphergau==1) then
	allocate(shelltype5D(nshell))
	shelltype5D=shelltype
	where (shelltype<=-2) shelltype=-shelltype !Convert to Cartesian type
	nbasis5D=nbasis
	nbasis=0
	do i=1,nshell
		nbasis=nbasis+shtype2nbas(shelltype(i))
	end do
end if
allocate(shelltype6D(nshell)) !Back up shell information of Cartesian basis
shelltype6D=shelltype
nbasisCar=nbasis

!Allocate space for arrays
nprims=0
do i=1,nshell
	nprims=nprims+shtype2nbas(shelltype(i))*shellcon(i)
end do
allocate(b(nprims),CO(nmo,nprims),basshell(nbasis),bascen(nbasis),bastype(nbasis),primstart(nbasis),&
primend(nbasis),primconnorm(nprims),basstart(ncenter),basend(ncenter))
!Fill Cobasa and CObasb
if (isphergau==0) then
	allocate(CObasa(nbasis,nbasis))
	CObasa=transpose(amocoeff)
	if (wfntype==1.or.wfntype==4) then
		allocate(CObasb(nbasis,nbasis))
		CObasb=transpose(bmocoeff)
	end if
else if (isphergau==1) then
	allocate(CObasa(nbasis,nbasis),CObasa5D(nbasis5D,nbasis5D))
	CObasa5D=transpose(amocoeff)
	CObasa=0D0
	if (wfntype==1.or.wfntype==4) then
		allocate(CObasb(nbasis,nbasis),CObasb5D(nbasis5D,nbasis5D))
		CObasb5D=transpose(bmocoeff)
		CObasb=0D0
	end if
	!Map 5D coefficient to 6D coefficient
	ipos5D=1
	ipos6D=1
	do ish=1,nshell
		ishtyp5D=shelltype5D(ish)
		ishtyp6D=shelltype(ish)
		numshorb5D=shtype2nbas(ishtyp5D)
		numshorb6D=shtype2nbas(ishtyp6D)
		if (ishtyp5D>=-1) then !S or P or SP or other Cartesian shells
			CObasa(ipos6D:ipos6D+numshorb6D-1,1:nbasis5D)=CObasa5D(ipos5D:ipos5D+numshorb5D-1,:)
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+numshorb6D-1,1:nbasis5D)=CObasb5D(ipos5D:ipos5D+numshorb5D-1,:)
		else if (ishtyp5D==-2) then
			!5D->6D
			CObasa(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,CObasa5D(ipos5D:ipos5D+4,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,CObasb5D(ipos5D:ipos5D+4,:))
		else if (ishtyp5D==-3) then
			!7F->10F
			CObasa(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,CObasa5D(ipos5D:ipos5D+6,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,CObasb5D(ipos5D:ipos5D+6,:))
		else if (ishtyp5D==-4) then
			!9G->15G
			CObasa(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,CObasa5D(ipos5D:ipos5D+8,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,CObasb5D(ipos5D:ipos5D+8,:))
		else if (ishtyp5D==-5) then
			!11H->21H
			CObasa(ipos6D:ipos6D+20,1:nbasis5D)=matmul(conv11h21h,CObasa5D(ipos5D:ipos5D+10,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+20,1:nbasis5D)=matmul(conv11h21h,CObasb5D(ipos5D:ipos5D+10,:))
		end if
		ipos5D=ipos5D+numshorb5D
		ipos6D=ipos6D+numshorb6D
	end do
end if

if (infomode==0) write(*,*) "Converting basis function information to GTF information..."
!Distribute exponent, functype to every GTF and generate CO(:,:) from amocoeff/bmocoeff
!Fill: b,basshell,bascen,bastype,co,primstart,primend,primconnorm
k=1 !Current position of GTF
iexp=1
ibasis=1 !Current position of basis
!Note: Below commented with !!! means the line associated to setting basis information
do i=1,nshell !cycle each shell
	b(k:k+shellcon(i)*shtype2nbas(shelltype(i))-1)%center=shell2atom(i)
	basshell(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=i !!! Set basis attributed to which shell
	bascen(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=shell2atom(i) !!! Set basis attributed to which center
	do j=1,shtype2nbas(shelltype(i)) !cycle each basis(orbital) in each shell
		b(k:k+shellcon(i)-1)%type=s2f(shelltype(i),j)
		bastype(ibasis)=s2f(shelltype(i),j) !!! set basis type
		primstart(ibasis)=k !!! From where the GTFs attributed to ibasis'th basis
		primend(ibasis)=k+shellcon(i)-1 !!! To where the GTFs attributed to ibasis'th basis
        !write(*,*) i,j,ibasis,primstart(ibasis),primend(ibasis)
		do l=1,shellcon(i) !cycle each GTF in each basis in each shell
			b(k)%exp=primexp(iexp+l-1)
			tnormgau=normgau(b(k)%type,b(k)%exp)  !!!Normalization coefficient of GTFs
			if (ifchprog==2) tnormgau=1D0 !In the .fch file of old version of Q-chem (may be older than 5.0), normalization factor of GTF has already been multiplied into contraction coefficient of GTFs
			temp=concoeff(iexp+l-1)  !!!Contraction coefficient of GTFs
			if (shelltype(i)==-1.and.j/=1) temp=SPconcoeff(iexp+l-1)
			primconnorm(k)=temp*tnormgau !Combines contraction and normalization coefficient
			do imo=1,nmo
				if (wfntype==0.or.wfntype==2.or.wfntype==3) then !R or RO
					CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
				else if (wfntype==1.or.wfntype==4) then !U
					if (isphergau==1) then
						if (imo<=nbasis5D) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
						if (imo>nbasis5D) CO(imo,k)=CObasb(ibasis,imo-nbasis5D)*temp*tnormgau
					else
						if (imo<=nbasis) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
						if (imo>nbasis) CO(imo,k)=CObasb(ibasis,imo-nbasis)*temp*tnormgau
					end if
				end if
			end do
			k=k+1
		end do
		ibasis=ibasis+1
	end do
	iexp=iexp+shellcon(i)
end do

!Convert information from Cartesian basis to spherical basis
if (isphergau==1) then
	if (iloadasCart==1) then !For special purpose, keep Cartesian basis functions, e.g. convert spherical .fch/.molden to .47 file
		!Currently nbasis and dimension of all matrix (except for CO) correspond to full Cartesian case, but nmo &
		!and related arrays as well as CO still correspond to spherical harmonic case and thus need to be "expanded", the MO energies are artifically set to 100
		allocate(MOocc5D(nmo),MOene5D(nmo),MOtype5D(nmo),CO5D(nmo,nprims))
		MOocc5D=MOocc
		MOene5D=MOene
		MOtype5D=MOtype
		CO5D=CO
		deallocate(MOocc,MOene,MOtype,CO)
		if (wfntype==0.or.wfntype==2.or.wfntype==3) nmo=nbasis !R, RO
		if (wfntype==1.or.wfntype==4) nmo=2*nbasis !U
		allocate(MOocc(nmo),MOene(nmo),MOtype(nmo),CO(nmo,nprims))
		MOocc=0
		MOene=100
		CO=0
		if (wfntype==0.or.wfntype==2.or.wfntype==3) then !R, RO
			MOtype=0
			MOocc(1:nbasis5D)=MOocc5D
			MOene(1:nbasis5D)=MOene5D
			MOtype(1:nbasis5D)=MOtype5D
			CO(1:nbasis5D,:)=CO5D
		else !U
			MOtype(:nbasis)=1
			MOtype(nbasis+1:)=2
			MOocc(:nbasis5D)=MOocc5D(:nbasis5D)
			MOocc(nbasis+1:nbasis+nbasis5D)=MOocc5D(nbasis5D+1:)
			MOene(:nbasis5D)=MOene5D(:nbasis5D)
			MOene(nbasis+1:nbasis+nbasis5D)=MOene5D(nbasis5D+1:)
			MOtype(:nbasis5D)=MOtype5D(:nbasis5D)
			MOtype(nbasis+1:nbasis+nbasis5D)=MOtype5D(nbasis5D+1:)
			CO(:nbasis5D,:)=CO5D(:nbasis5D,:)
			CO(nbasis+1:nbasis+nbasis5D,:)=CO5D(nbasis5D+1:,:)
		end if
		isphergau=0

	else !Common case, transform to spherical functions
		if (infomode==0) write(*,*) "Back converting basis function information from Cartesian to spherical type..."
		!Recover spherical Gaussian basis function information
		nbasis=nbasis5D
		shelltype=shelltype5D
		ibasis=1
		do i=1,nshell
			basshell(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=i
			bascen(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=shell2atom(i)
			do j=1,shtype2nbas(shelltype(i))
				bastype(ibasis)=s2f(shelltype(i),j)
				ibasis=ibasis+1
			end do
		end do
		deallocate(CObasa)
		allocate(CObasa(nbasis,nbasis))
		CObasa=CObasa5D
		if (wfntype==1.or.wfntype==4) then
			deallocate(CObasb)
			allocate(CObasb(nbasis,nbasis))
			CObasb=CObasb5D
		end if
	end if
end if

!Split SP shell to S and P shells
noldshell=nshell
noldprimshell=nprimshell
ibasis=1
do i=1,nshell !Count how many basis shells and primitive shells after splitting SP as S and P, and meantime update basshell
	if (shelltype(i)==-1) then
		nshell=nshell+1
		nprimshell=nprimshell+shellcon(i)
		basshell(ibasis+1:nbasis)=basshell(ibasis+1:nbasis)+1 !The shell index of the basis function after current one should be augmented by 1, since current shell is splitted
	end if
	ibasis=ibasis+shtype2nbas(shelltype(i))
end do
allocate(shtype(nshell),shtypeCar(nshell),shcen(nshell),shcon(nshell),primshexp(nprimshell),primshcoeff(nprimshell)) !Global array
jsh=1 !New basis shell index
iprsh=1 !Old primitive shell index
jprsh=1 !New primitive shell index
do ish=1,noldshell !Finally determine global arrays shtype,shcen,shcon,primshexp,primshcoeff shell arrays, in which SP shells are not presented
	ncon=shellcon(ish)
	if (shelltype(ish)/=-1) then !Normal shell
		shtype(jsh)=shelltype(ish)
        shtypeCar(jsh)=shelltype6D(ish)
		shcen(jsh)=shell2atom(ish)
		shcon(jsh)=ncon
		primshexp(jprsh:jprsh+ncon-1)=primexp(iprsh:iprsh+ncon-1)
		primshcoeff(jprsh:jprsh+ncon-1)=concoeff(iprsh:iprsh+ncon-1)
		jsh=jsh+1
		jprsh=jprsh+ncon
	else !SP shell
		shtype(jsh)=0 !S
		shtype(jsh+1)=1 !P
		shtypeCar(jsh)=0 !S
		shtypeCar(jsh+1)=1 !P
		shcen(jsh:jsh+1)=shell2atom(ish)
		shcon(jsh:jsh+1)=ncon
		primshexp(jprsh:jprsh+ncon-1)=primexp(iprsh:iprsh+ncon-1)
		primshexp(jprsh+ncon:jprsh+2*ncon-1)=primexp(iprsh:iprsh+ncon-1)
		primshcoeff(jprsh:jprsh+ncon-1)=concoeff(iprsh:iprsh+ncon-1)
		primshcoeff(jprsh+ncon:jprsh+2*ncon-1)=SPconcoeff(iprsh:iprsh+ncon-1)
		jsh=jsh+2
		jprsh=jprsh+2*ncon
	end if
	iprsh=iprsh+ncon
end do

!Generate basstart and basend
nowcen=0
indcen=0
basstart=0 !Bq atom without basis function will have 0 for basstart and basend
basend=0
do ibasis=1,nbasis
	if (bascen(ibasis)/=nowcen) then
		nowcen=bascen(ibasis)
		indcen=indcen+1
		basstart(indcen)=ibasis
		if (indcen/=1) basend(indcen-1)=ibasis-1
	end if
end do
basend(ncenter)=nbasis

!Generate one-particle matrix in basis functions
if (igenP==1) then
	if (infomode==0) then
		if (isaveNO==0) write(*,*) "Generating density matrix based on SCF orbitals..."
		if (isaveNO==1) write(*,*) "Generating density matrix based on natural orbitals..."
	end if
	call genP
end if

!Generate overlap matrix and check wavefunction sanity. It is meaningless to generate Sbas in usual way for PBC systems
if (ifPBC==0) then
    if (infomode==0) write(*,*) "Generating overlap matrix..."
    call genSbas_curr
    devtmp=abs(sum(Sbas*Ptot)-nint(nelec))
    if (devtmp>0.01D0) then
	    write(*,"(' Deviation of Tr(S*P) to the total number of electrons:',f12.6)") devtmp
	    write(*,"(' Tr(S*P) is',f12.6)") sum(Sbas*Ptot)
	    write(*,"(' Total number of electrons is',i10)") nint(nelec)
	    write(*,"(/,a)") " Warning: The loaded wavefunction is incorrect! That means this file is problematic"
	    write(*,"(a)") " If you really want to proceed, the result may be incorrect"
	    !write(*,"(a)") " If you really want to proceed, press ENTER button now, but the result may be incorrect"
	    !read(*,*)
    end if
end if

!Output summary of present wavefunction
if (infomode==0) then
	write(*,*)
	write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Net charge:',f12.5,'      Expected multiplicity:',i5)") sum(a(:)%charge)-nelec,nint(naelec-nbelec)+1
	write(*,"(' Atoms:',i7,',  Basis functions:',i7,',  GTFs:',i7)") ncenter,nbasis,nprims
	write(*,"(' Total energy:',f21.12,' Hartree,   Virial ratio:',f12.8)") totenergy,virialratio
	if (wfntype==0) then
		write(*,"(' This is a restricted single-determinant wavefunction')")
		write(*,"(' Orbitals from 1 to',i6,' are occupied')") nint(nelec/2)
	else if (wfntype==1) then
		write(*,"(' This is an unrestricted single-determinant wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are occupied')") 1,nbasis,1,nint(naelec)
		write(*,"(' Orbitals from ',i6,' to',i6,' are beta,  from',i6,' to',i6,' are occupied')") nbasis+1,nmo,nbasis+1,nbasis+nint(nbelec)
	else if (wfntype==2) then
		write(*,"(' This is a restricted open-shell wavefunction')")
		write(*,"(' Orbitals from',i6,' to',i6,' are doubly occupied')") 1,nint(nbelec)
		write(*,"(' Orbitals from',i6,' to',i6,' are singly occupied')") nint(nbelec)+1,nint(naelec)
	else if (wfntype==3) then
		write(*,"(' This is a restricted multiconfiguration wavefunction')")
	else if (wfntype==4) then
		write(*,"(' This is an unrestricted multiconfiguration wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are beta')") 1,nbasis,nbasis+1,nmo
	end if
	write(*,"(' Title line of this file: ',a)") trim(fchtitle)
end if

call getHOMOidx !Find out index of HOMO, will be used in some cases
end subroutine

!!--------------------------------------------------------------------
!!-------------- Read Gaussian formatted check file for AdNDP analysis
!Cobasa is not read from .fch file, which has already written by AdNDP module, which contains AO expansion coefficients of candidate or saved orbitals
subroutine readfchadndp(fchfilename,iusespin,orbocc,adndpCObas,numorb)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) fchfilename
character c80*80
integer iusespin,numorb
real*8 orbocc(numorb),adndpCObas(nbasis,numorb)
integer,allocatable :: shelltype(:),shell2atom(:),shellcon(:) !Degree of shell contraction
real*8,allocatable :: primexp(:),concoeff(:),SPconcoeff(:)
integer :: s2f(-5:5,21)=0 !Give shell type & orbital index to get functype
real*8 conv5d6d(6,5),conv7f10f(10,7),conv9g15g(15,9),conv11h21h(21,11)
 !For backing up spherical basis functions
integer,allocatable :: shelltype5D(:)
real*8,allocatable :: CObasa5D(:,:)
real*8,external :: normgau
nmo=numorb
s2f(-5,1:11)=(/ -32,-31,-30,-29,-28,-27,-26,-25,-24,-23,-22 /)
s2f(-4,1:9)=(/ -21,-20,-19,-18,-17,-16,-15,-14,-13 /)
s2f(-3,1:7)=(/ -12,-11,-10,-9,-8,-7,-6 /)
s2f(-2,1:5)=(/ -5,-4,-3,-2,-1 /)
s2f(-1,1:4)=(/ 1,2,3,4 /)
s2f(0,1)=1
s2f(1,1:3)=(/ 2,3,4 /)
s2f(2,1:6)=(/ 5,6,7,8,9,10 /)
s2f(3,1:10)=(/ 11,12,13,17,14,15,18,19,16,20 /)
s2f(4,1:15)=(/ 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35 /)
s2f(5,1:21)=(/ 36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56 /)
call gensphcartab(1,conv5d6d,conv7f10f,conv9g15g,conv11h21h)

open(10,file=fchfilename,status="old")

call loclabel(10,'Nuclear charges') !If ECP was used, nuclear charge /= atomic number
read(10,*)
read(10,"(5(1PE16.8))") (a(i)%charge,i=1,ncenter)
call loclabel(10,'Current cartesian coordinates')
read(10,*)
read(10,"(5(1PE16.8))") (a(i)%x,a(i)%y,a(i)%z,i=1,ncenter)

call loclabel(10,'Shell types')
read(10,"(49x,i12)") nshell
allocate(shelltype(nshell))
read(10,"(6i12)") (shelltype(i),i=1,nshell)
isphergau=0
if (any(shelltype<=-2)) isphergau=1
call loclabel(10,'Number of primitives per shell')
read(10,*)
allocate(shellcon(nshell))
read(10,"(6i12)") (shellcon(i),i=1,nshell)
call loclabel(10,'Shell to atom map')
read(10,*)
allocate(shell2atom(nshell))
read(10,"(6i12)") (shell2atom(i),i=1,nshell)
call loclabel(10,'Primitive exponents')
read(10,"(49x,i12)") nprimshell
allocate(primexp(nprimshell))
read(10,"(5(1PE16.8))") (primexp(i),i=1,nprimshell)
call loclabel(10,'Contraction coefficients')
read(10,*)
allocate(concoeff(nprimshell))
read(10,"(5(1PE16.8))") (concoeff(i),i=1,nprimshell)
read(10,"(a)") c80
if (index(c80,"P(S=P) Contraction coefficients")/=0) then
	backspace(10)
	read(10,*)
	allocate(SPconcoeff(nprimshell))
	read(10,"(5(1PE16.8))") (SPconcoeff(i),i=1,nprimshell)
end if

if (allocated(MOene)) deallocate(MOene)
if (allocated(MOocc)) deallocate(MOocc)
if (allocated(MOtype)) deallocate(MOtype)
allocate(MOene(nmo),MOocc(nmo),MOtype(nmo))
MOene=0D0
MOocc=orbocc
MOtype=iusespin

nbasis_org=nbasis
if (isphergau==1) then
	allocate(shelltype5D(nshell))
	shelltype5D=shelltype
	where (shelltype<=-2) shelltype=-shelltype !Convert to Cartesian type
	nbasis5D=nbasis
	nbasis=0
	do i=1,nshell
		nbasis=nbasis+shtype2nbas(shelltype(i))
	end do
end if
if (allocated(shtypeCar)) deallocate(shtypeCar)
allocate(shtypeCar(nbasis)) !Store shell information of Cartesian basis into global array, which may be used later
shtypeCar=shelltype
nbasisCar=nbasis

!Allocate space for arrays
nprims=0
do i=1,nshell
	nprims=nprims+shtype2nbas(shelltype(i))*shellcon(i)
end do
if (.not.allocated(b)) allocate(b(nprims))
if (allocated(CO)) deallocate(CO)
allocate(CO(nmo,nprims))

if (isphergau==0) then
	if (allocated(CObasa)) deallocate(CObasa)
	allocate(CObasa(nbasis,nmo))
	CObasa=adndpCObas
else if (isphergau==1) then
	if (allocated(CObasa)) deallocate(CObasa)
	allocate(CObasa(nbasis,nmo),CObasa5D(nbasis5D,nmo))
	CObasa5D=adndpCObas
	CObasa=0D0

	!Map 5D coefficient to 6D coefficient
	ipos5D=1
	ipos6D=1
	do ish=1,nshell
		ishtyp5D=shelltype5D(ish)
		ishtyp6D=shelltype(ish)
		numshorb5D=shtype2nbas(ishtyp5D)
		numshorb6D=shtype2nbas(ishtyp6D)
		if (ishtyp5D==0.or.ishtyp5D==1.or.ishtyp5D==-1) then !S or P or SP
			CObasa(ipos6D:ipos6D+numshorb6D-1,1:nmo)=CObasa5D(ipos5D:ipos5D+numshorb5D-1,1:nmo)
		else if (ishtyp5D==-2) then
			!5D->6D
			CObasa(ipos6D:ipos6D+5,1:nmo)=matmul(conv5d6d,CObasa5D(ipos5D:ipos5D+4,1:nmo))
		else if (ishtyp5D==-3) then
			!7F->10F
			CObasa(ipos6D:ipos6D+9,1:nmo)=matmul(conv7f10f,CObasa5D(ipos5D:ipos5D+6,1:nmo))
		else if (ishtyp5D==-4) then
			!9G->15G
			CObasa(ipos6D:ipos6D+14,1:nmo)=matmul(conv9g15g,CObasa5D(ipos5D:ipos5D+8,1:nmo))
		else if (ishtyp5D==-5) then
			!11H->21H
			CObasa(ipos6D:ipos6D+20,1:nmo)=matmul(conv11h21h,CObasa5D(ipos5D:ipos5D+10,1:nmo))
		end if
		ipos5D=ipos5D+numshorb5D
		ipos6D=ipos6D+numshorb6D
	end do
end if

!Distribute exponent, functype to every GTF and generate CO(:,:) from CObasa
k=1 !current position of GTF
iexp=1
ibasis=1 !current position of basis
!Note: Below commented with !!! means the line associated to setting basis information
do i=1,nshell !cycle each shell
	b(k:k+shellcon(i)*shtype2nbas(shelltype(i))-1)%center=shell2atom(i)
	do j=1,shtype2nbas(shelltype(i)) !cycle each basis(orbital) in each shell
		b(k:k+shellcon(i)-1)%type=s2f(shelltype(i),j)
		do l=1,shellcon(i) !cycle each GTF in each basis in each shell
			b(k)%exp=primexp(iexp+l-1)
			tnormgau=normgau(b(k)%type,b(k)%exp)
			temp=concoeff(iexp+l-1)
			if (shelltype(i)==-1.and.j/=1) temp=SPconcoeff(iexp+l-1)
			do imo=1,nmo
				CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
			end do
			k=k+1
		end do
		ibasis=ibasis+1
	end do
	iexp=iexp+shellcon(i)
end do

close(10)

nbasis=nbasis_org
end subroutine

!!------------------------------------------------------------------------
!!------------- Read .chg file that only contain atomic charge information
subroutine readchg(name,infomode) !infomode=0 means output info, =1 silent
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) name
integer i
real*8 dipx,dipy,dipz,tdip
ifiletype=4
open(10,file=name,status="old")
ncenter=totlinenum(10,1)
allocate(a(ncenter))
do i=1,ncenter
	read(10,*) a(i)%name,a(i)%x,a(i)%y,a(i)%z,a(i)%charge
	do j=0,nelesupp
		if (a(i)%name==ind2name(j)) then
			a(i)%index=j
			exit
		end if
		if (j==nelesupp) write(*,*) "Warning: Found unknown element!"
	end do
end do
close(10)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
dipx=sum(a(:)%x*a(:)%charge)
dipy=sum(a(:)%y*a(:)%charge)
dipz=sum(a(:)%z*a(:)%charge)
if (infomode==0) then
	write(*,"(' Totally',i8,' atoms')") ncenter
	write(*,"(' Sum of all atomic charges:',f12.6)") sum(a%charge)
	write(*,"(' Component of electric dipole moment:')")
	write(*,"(' X=',f12.6,' a.u.  (',f12.6,' Debye )')") dipx,dipx*au2debye
	write(*,"(' Y=',f12.6,' a.u.  (',f12.6,' Debye )')") dipy,dipy*au2debye
	write(*,"(' Z=',f12.6,' a.u.  (',f12.6,' Debye )')") dipz,dipz*au2debye
	tdip=dsqrt(dipx**2+dipy**2+dipz**2)
	write(*,"(' Total electric dipole moment:',f12.6,' a.u.  (',f12.6,' Debye )')") tdip,tdip*au2debye
end if
end subroutine

!!----------------------------------------------------------------
!!-------------------- Read .pdb or .pqr file --------------------
! infomode=0: Output summary, =1: do not
! ipqr=0: read as pdb, =1: read as pqr
subroutine readpdb_pqr(name,infomode,ipqr)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode,ipqr
character(len=*) name
character test*6,tmpname*4,tmpname_up*4,element*3
character c80tmp*80
ifiletype=5
open(10,file=name,status="old")
ncenter=0
do while(.true.)
	read(10,"(a6)",iostat=ierror) test
	if (ierror/=0) exit
	if (test=="HETATM".OR.test=="ATOM  ") ncenter=ncenter+1
end do
rewind(10)
allocate(a(ncenter))
i=0
do while(.true.)
	read(10,"(a6)",iostat=ierror) test
	if (ierror/=0) exit
	if (test=="HETATM".or.test=="ATOM  ") then
		backspace(10)
		i=i+1
		read(10,"(12x,a4,1x,a3,2x,i4,4x,3f8.3,22x,a3)") tmpname,a(i)%resname,a(i)%resid,a(i)%x,a(i)%y,a(i)%z,element
		if (ipqr==1) then !Use free-format to load atomic charge
			backspace(10)
			read(10,"(a)") c80tmp
			read(c80tmp(55:76),*) a(i)%charge
		end if
		element=adjustl(element)
		ifound=0
		!Use "element" term to determine actual element
		do j=0,nelesupp
			if (ind2name_up(j)==element(1:2).or.ind2name(j)==element(1:2)) then
				a(i)%index=j
				ifound=1
				exit
			end if
		end do
		!"Element" term is missing, use atomic name to determine element
		if (ifound==0) then
			tmpname_up=adjustl(tmpname)
			call strlc2uc(tmpname_up)
            ifound=0
			do j=1,nelesupp !Recognize e.g. CL1, Li
                if (ind2name_up(j)==tmpname_up(1:2)) then
                    a(i)%index=j
					ifound=1
					exit
                end if
            end do
            if (ifound==0) then
			    do j=1,nelesupp
				    if (ind2name_up(j)==tmpname_up(1:1)//' ' .or.  & !Recognize e.g. C, N11, Li
				    ((ichar(tmpname_up(1:1))<=57).and.ind2name_up(j)==tmpname_up(2:2)//' ')) then !Recognize such as 1H5*
					    a(i)%index=j
					    ifound=1
					    exit
				    end if
			    end do
            end if
		end if
		if (ifound==0) then
			write(*,"(3a)") " Warning: Found unknown element """,tmpname,""" , assume it is carbon"
			a(i)%index=12
		end if
		if (ipqr==0) a(i)%charge=a(i)%index
		a(i)%name=ind2name(a(i)%index)
	end if
end do
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a

iresinfo=1 !Residue information is available in this file

!Try to load cell information
call loclabel(10,"CRYST1  ",ifound)
if (ifound==1) then
    read(10,"(6x,3f9.3,3f7.2)") asize,bsize,csize,alpha,beta,gamma
    asize=asize/b2a
    bsize=bsize/b2a
    csize=csize/b2a
    call abc2cellv(asize,bsize,csize,alpha,beta,gamma)
    ifPBC=3
end if
close(10)

if (infomode==0) then
	write(*,"(' Totally',i8,' atoms')") ncenter
	if (ipqr==1) write(*,"(' Sum of atomic charges:',f12.6)") sum(a%charge)
end if

call guessnelec

end subroutine

!!--------------------------------------------------------
!!-------------------- Read .xyz file --------------------
! infomode=0: Output summary, =1: do not
! iopen=0 means don't open and close file in this routine, used to continuously read trjectory. =1 means do these
!Rule of detecting atom element indices: If there is a .pdb file with same path, use element from it to guess index if element is not blank, &
!otherwise guess index from atom name in xyz
subroutine readxyz(name,infomode,iopen)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode,iopen
character(len=*) name
character*200 titleline
character pdbpath*200,teststr*6

ifiletype=5
if (iopen==1) open(10,file=name,status="old")
ncenter=0
read(10,*) ncenter
read(10,"(a)") titleline
itmp=index(titleline,'spinmulti')
if (itmp/=0) then
    read(titleline(itmp+9:),*) loadmulti
    write(*,"(' Spin multiplicity:',i4)") loadmulti
end if
itmp=index(titleline,'charge ')
if (itmp/=0) then
    read(titleline(itmp+6:),*,iostat=ierror) loadcharge
    if (ierror/=0) then
        loadcharge=-99 !Default
    else
        write(*,"(' Net charge:',i4)") loadcharge
    end if
end if

!Load PBC information. If Multiwfn loaded a periodic system, then the exported xyz file will carry this kind of information
itmp=index(titleline,'Tv_1:')
if (itmp/=0) then
    read(titleline(itmp+5:),*) cellv1(:)
    cellv1=cellv1/b2a
    ifPBC=1
end if
itmp=index(titleline,'Tv_2:')
if (itmp/=0) then
    read(titleline(itmp+5:),*) cellv2(:)
    cellv2=cellv2/b2a
    ifPBC=2
end if
itmp=index(titleline,'Tv_3:')
if (itmp/=0) then
    read(titleline(itmp+5:),*) cellv3(:)
    cellv3=cellv3/b2a
    ifPBC=3
end if

if (allocated(a)) deallocate(a)
allocate(a(ncenter))
ipos=index(name,'.',back=.true.)
pdbpath=name(:ipos-1)//".pdb"
inquire(file=pdbpath,exist=alive)
if (alive) then
    if (infomode==0) write(*,"(a)") " Note: Found "//trim(pdbpath)//", element names in this file will be used instead if given"
    open(11,file=pdbpath,status="old")
    do while(.true.) !Find the first atom section
	    read(11,"(a6)") teststr
	    if (teststr=="HETATM".OR.teststr=="ATOM  ") then
            backspace(11)
            exit
        end if
    end do
end if

do i=1,ncenter
	read(10,*) a(i)%name,a(i)%x,a(i)%y,a(i)%z
    if (alive) then
        read(11,"(76x,a2)") teststr(1:2) !Load element from pdb file
        if (teststr(1:2)/=" ") a(i)%name=adjustl(teststr(1:2)) !If pdb file doesn't provide element name, still use name in .xyz
    end if
	call lc2uc(a(i)%name(1:1)) !Convert to upper case
	call uc2lc(a(i)%name(2:2)) !Convert to lower case
	do j=1,nelesupp
		if ( a(i)%name==ind2name(j) ) then
			a(i)%index=j
			exit
		end if
	end do
	if (j==nelesupp+1) then !Only use the first letter of atom name to try to assign. For example OW, HW may be in .xyz file
		do j=1,nelesupp
			if ( ind2name(j)(2:2)==" ".and.a(i)%name(1:1)==ind2name(j)(1:1) ) then
				a(i)%index=j
				exit
			end if
		end do
	end if
	if (j==nelesupp+1) then
		write(*,"(/,3a)") " Warning: Found unknown element """,a(i)%name,""", assume it is carbon"
		a(i)%index=12
	end if
end do
if (iopen==1) close(10)
if (alive) close(11)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
a%charge=a%index
a%name=ind2name(a%index)
if (infomode==0) then
	write(*,"(' Title line: ',a)") trim(titleline)
	write(*,"(' Totally',i8,' atoms')") ncenter
end if
call guessnelec
end subroutine

!!---------- Read a frame of xyz trajectory form a given ifileid
!Only coordinates will be loaded, other information will not be loaded as "readxyz"
!Commonly readxyz should be used prior to this to assign other information
!This routine will not open/close file, and will not allocate/deallocate "a"
subroutine readxyztrj(ifileid)
use defvar
implicit real*8 (a-h,o-z)
integer ifileid
character c80tmp*80
read(ifileid,*)
read(ifileid,*)
do i=1,ncenter
	read(ifileid,*) c80tmp,a(i)%x,a(i)%y,a(i)%z
end do
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
end subroutine

!!--------- Get number of frame in .xyz file. The xyz file must have been opened with id=ifileid
subroutine xyzfile_nframe(ifileid,nframe)
use defvar
implicit real*8 (a-h,o-z)
integer ifileid,nframe
character c80tmp*80
nframe=0
do while(.true.)
    read(ifileid,*,iostat=ierror) c80tmp
    if (ierror/=0.or.c80tmp==" ") then
        return
    else
        nframe=nframe+1
    end if
    read(ifileid,*)
    do i=1,ncenter
	    read(ifileid,*) c80tmp,tmpx,tmpy,tmpz
    end do
end do
end subroutine

!!---------------------------------------------------------------------
!!------------ Load Turobmole coordinate file ($coord at the first line)
! infomode=0: Output summary, =1: do not
subroutine readTurbomole(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character c80tmp*80

ifiletype=5 !The same as xyz
open(10,file=name,status="old")

call loclabel(10,"$coord")
read(10,*)
ncenter=0
do while(.true.)
	read(10,*,iostat=ierror) c80tmp
    if (c80tmp==" ".or.index(c80tmp,'$')/=0.or.ierror/=0) exit
    ncenter=ncenter+1
end do
if (infomode==0) write(*,"(' Totally',i8,' atoms')") ncenter

if (allocated(a)) deallocate(a)
allocate(a(ncenter))

call loclabel(10,"$coord")
read(10,*)
do i=1,ncenter
	read(10,*) a(i)%x,a(i)%y,a(i)%z,a(i)%name
	call lc2uc(a(i)%name(1:1)) !Convert to upper case
	call uc2lc(a(i)%name(2:2)) !Convert to lower case
	do j=1,nelesupp
		if ( a(i)%name==ind2name(j) ) then
			a(i)%index=j
			exit
		end if
	end do
	if (j==nelesupp+1) then
		write(*,"(/,3a)") " Warning: Found unknown element """,a(i)%name,""", assume it is carbon"
		a(i)%index=12
	end if
end do

close(10)

a%charge=a%index
a%name=ind2name(a%index)
call guessnelec

end subroutine

!!---------------------------------------------------
!!-------------------- Read .gro --------------------
! infomode=0: Output summary, =1: do not
subroutine readgro(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character resname*5,resname_up*5,tmpname*5,tmpname_up*5,c200tmp*200
ifiletype=15
open(10,file=name,status="old")
read(10,*)
read(10,*) ncenter
allocate(a(ncenter))
do iatm=1,ncenter
    read(10,"(i5,2a5,i5,3f8.3)") a(iatm)%resid,resname,tmpname,inouse,a(iatm)%x,a(iatm)%y,a(iatm)%z
	tmpname_up=adjustl(tmpname)
    resname_up=adjustl(resname)
	call strlc2uc(tmpname_up)
	call strlc2uc(resname_up)
    ifound=0
    if (tmpname_up==resname_up) then !If resname and atomname are identical, for example NA, CL, CA, then they should be ion, directly recognize
        do i=1,nelesupp
            if (ind2name_up(i)==tmpname_up) then
			    a(iatm)%index=i
			    ifound=1
			    exit
		    end if
        end do
    end if
    if (ifound==0) then !Guess element according to atomname
	    do i=1,nelesupp
		    if (ind2name_up(i)==tmpname_up(1:1)//' ' .or. ind2name_up(i)==tmpname_up(1:2) .or. & !Recognize e.g. C, N11, Li
		    ((ichar(tmpname_up(1:1))<=57).and.ind2name_up(i)==tmpname_up(2:2)//' ')) then !Recognize such as 1H5*
			    a(iatm)%index=i
			    ifound=1
			    exit
		    end if
	    end do
    end if
    if (ifound==0) then
	    write(*,"(a)") " Warning: Element of """//trim(tmpname)//""" cannot be recognized, assume it is carbon"
	    a(iatm)%index=12
    end if
    a(iatm)%name=ind2name(a(iatm)%index)
    a(iatm)%resname=resname(1:4)
end do
read(10,"(a)") c200tmp
read(c200tmp,*,iostat=ierror) cellv1(1),cellv2(2),cellv3(3),cellv1(2),cellv1(3),cellv2(1),cellv2(3),cellv3(1),cellv3(2)
if (ierror/=0) then
    cellv1=0;cellv2=0;cellv3=0
    read(c200tmp,*) cellv1(1),cellv2(2),cellv3(3)
end if
cellv1=cellv1*10/b2a !to Angstrom, then to Bohr
cellv2=cellv2*10/b2a
cellv3=cellv3*10/b2a
ifPBC=3
close(10)
a%x=a%x*10/b2a
a%y=a%y*10/b2a
a%z=a%z*10/b2a
iresinfo=1 !Residue information is available in this file
if (infomode==0) write(*,"(' Totally',i8,' atoms')") ncenter
end subroutine

!!--------------------------------------------------------
!!-------------------- Read .gjf file --------------------
! Only support Cartesian coordinate currently
! infomode=0: Output summary, =1: Do not
subroutine readgjf(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character c40tmp*40,c200tmp*200
ifiletype=12
open(10,file=name,status="old")
iskip=0 !How many lines before charge and multiplicity line
iblank=0
do while(.true.)
	read(10,"(a)") c200tmp
	iskip=iskip+1
	if (c200tmp==" ") iblank=iblank+1
	if (iblank==2) exit
end do
read(10,*) loadcharge,loadmulti

ncenter=0
do while(.true.)
	read(10,"(a)",iostat=ierror) c200tmp
	if (c200tmp==" ".or.index(c200tmp,"Tv")/=0.or.index(c200tmp,"TV")/=0.or.index(c200tmp,"tv")/=0.or.ierror/=0) exit
	ncenter=ncenter+1
end do

if (allocated(a)) deallocate(a)
allocate(a(ncenter))
rewind(10)
do i=1,iskip
	read(10,*)
end do
read(10,*)

do i=1,ncenter
    read(10,"(a)") c200tmp
    ibeg=index(c200tmp,'(')
    iend=index(c200tmp,')')
    if (iend>ibeg) c200tmp(ibeg:iend)=" " !Purify the line to clean (...) information
	read(c200tmp,*,iostat=ierror) a(i)%name,c40tmp
	if (ierror/=0) then
		write(*,"(a)") " Error: Unable to load atom information. The input file is too complicated &
        or Z-matrix is used, Multiwfn does not support these cases"
		write(*,*) "Press ENTER button to exit program"
		read(*,*)
		stop
	end if
    if (index(c40tmp,'.')/=0) then !Didn't use 0 and -1 after atom name to indicate freeze status
	    read(c200tmp,*) a(i)%name,a(i)%x,a(i)%y,a(i)%z
    else
        read(c200tmp,*) a(i)%name,inouse,a(i)%x,a(i)%y,a(i)%z
    end if
	if (iachar(a(i)%name(1:1))>=48.and.iachar(a(i)%name(1:1))<=57) then !Use element index
		read(a(i)%name,*) a(i)%index
	else
		call lc2uc(a(i)%name(1:1)) !Convert to upper case
		call uc2lc(a(i)%name(2:2)) !Convert to lower case
        if (a(i)%name(1:2)=='X ') then !Dummy atom will be finally recognized as Bq
            a(i)%index=0
            cycle
        end if
		do j=0,nelesupp
			if ( a(i)%name==ind2name(j) ) then
				a(i)%index=j
				exit
			end if
		end do
	end if
end do
!Try to load translation vector (Tv)
read(10,"(a)",iostat=ierror) c200tmp
if (ierror==0.and.(index(c200tmp,"Tv")/=0.or.index(c200tmp,"TV")/=0.or.index(c200tmp,"tv")/=0)) then
    ifPBC=1
    read(c200tmp,*) c40tmp,cellv1
    cellv1=cellv1/b2a
    read(10,"(a)",iostat=ierror) c200tmp
    if (ierror==0.and.(index(c200tmp,"Tv")/=0.or.index(c200tmp,"TV")/=0.or.index(c200tmp,"tv")/=0)) then
        ifPBC=ifPBC+1
        read(c200tmp,*) c40tmp,cellv2
        cellv2=cellv2/b2a
        read(10,"(a)",iostat=ierror) c200tmp
        if (ierror==0.and.(index(c200tmp,"Tv")/=0.or.index(c200tmp,"TV")/=0.or.index(c200tmp,"tv")/=0)) then
            ifPBC=ifPBC+1
            read(c200tmp,*) c40tmp,cellv3
            cellv3=cellv3/b2a
        end if
    end if
end if
close(10)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
a%charge=a%index
a%name=ind2name(a%index)
nelec=sum(a%index)-loadcharge
naelec=(nint(nelec)+loadmulti-1)/2
nbelec=nelec-naelec
if (infomode==0) then
	write(*,"(' Totally',i8,' atoms')") ncenter
	write(*,"(' The number of alpha and beta electrons:',2i8)") nint(naelec),nint(nbelec)
end if
end subroutine

!!--------------------------------------------------------
!!-------------------- Read ORCA .inp file ---------------
! Only support Cartesian coordinate currently
! infomode=0: Output summary, =1: Do not
subroutine readORCAinp(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character c40tmp*40,c200tmp*200
ifiletype=12
open(10,file=name,status="old")
call loclabel(10,"* xyz ",ifound)
read(10,*) c40tmp,c40tmp,loadcharge,loadmulti

!Test how many centers
ncenter=0
do while(.true.)
	read(10,"(a)",iostat=ierror) c200tmp
	if (index(c200tmp,'*')/=0) exit
	if (index(c200tmp,':')/=0) cycle !Ignore ghost atom
	ncenter=ncenter+1
end do
if (allocated(a)) deallocate(a)
allocate(a(ncenter))

!Load atom information
call loclabel(10,"* xyz ",ifound)
read(10,*)
do i=1,ncenter
    read(10,"(a)") c200tmp
    ibeg=index(c200tmp,'(')
    iend=index(c200tmp,')')
    if (iend>ibeg) c200tmp(ibeg:iend)=" " !Purify the line to clean (...) information
	if (index(c200tmp,':')/=0) cycle !Ignore ghost atom
    read(c200tmp,*,iostat=ierror) a(i)%name,a(i)%x,a(i)%y,a(i)%z
	if (ierror/=0) then
		write(*,"(a)") " Error: Unable to successfully load atom information. The input file may be too complicated"
		write(*,*) "Press ENTER button to exit program"
		read(*,*)
		stop
	end if
    if (a(i)%name(1:2)=='DA') then !Dummy atom will be finally recognized as Bq
        a(i)%index=0
        cycle
    end if
	call lc2uc(a(i)%name(1:1)) !Convert to upper case
	call uc2lc(a(i)%name(2:2)) !Convert to lower case
	do j=0,nelesupp
		if ( a(i)%name==ind2name(j) ) then
			a(i)%index=j
			exit
		end if
	end do
end do
close(10)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
a%charge=a%index
a%name=ind2name(a%index)
nelec=sum(a%index)-loadcharge
naelec=(nint(nelec)+loadmulti-1)/2
nbelec=nelec-naelec
if (infomode==0) then
	write(*,"(' Totally',i8,' atoms')") ncenter
	write(*,"(' The number of alpha and beta electrons:',2i8)") nint(naelec),nint(nbelec)
end if
end subroutine

!!------------------------------------------------------------------------------
!!-------------------- Read CP2K input file or restart file --------------------
! infomode=0: Output summary, =1: do not
subroutine readcp2k(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character c40tmp*40,c200tmp*200
ifiletype=16
open(10,file=name,status="old")

call loclabel(10,"&CELL ",ifound) !Must be "&CELL " rather than "&CELL", the latter may locate to e.g. &CELL_OPT
do while(.true.)
    read(10,"(a)") c200tmp
    if (index(c200tmp,'&END')/=0) exit
    if (index(trim(c200tmp),'A ')/=0) read(c200tmp,*) c40tmp,cellv1
    if (index(trim(c200tmp),'B ')/=0) read(c200tmp,*) c40tmp,cellv2
    if (index(trim(c200tmp),'C ')/=0.and.index(c200tmp,'PERIODIC')==0) read(c200tmp,*) c40tmp,cellv3
    if (index(c200tmp,'ABC')/=0) then
        read(c200tmp,*) c40tmp,asize,bsize,csize
        alpha=90;beta=90;gamma=90
        call loclabel(10,"ALPHA_BETA_GAMMA",ifound)
        if (ifound==1) read(10,*) c40tmp,alpha,beta,gamma
        call abc2cellv(asize,bsize,csize,alpha,beta,gamma)
        exit
    end if
end do
cellv1=cellv1/b2a
cellv2=cellv2/b2a
cellv3=cellv3/b2a
ifPBC=3

call loclabel(10,"&SUBSYS")
call loclabel(10,"&COORD",ifound,0)
if (ifound==0) then
    write(*,*) "Error: Unable to find &COORD field, this file cannot be loaded!"
    write(*,*) "Press ENTER button to exit"
    read(*,*)
    stop
end if
read(10,*)
ncenter=0
do while(.true.)
    read(10,"(a)") c200tmp
    if (index(c200tmp,'&END')/=0) exit
    read(c200tmp,*,iostat=ierror) c40tmp,tmpx,tmpy,tmpz
    if (ierror/=0) cycle !This line may be e.g. "UNIT angstrom" or "SCALED  F"
    ncenter=ncenter+1
end do
if (allocated(a)) deallocate(a)
allocate(a(ncenter))

call loclabel(10,"&SUBSYS")
call loclabel(10,"&COORD",ifound,0)
read(10,*)
do i=1,ncenter
    read(10,"(a)") c200tmp
	read(c200tmp,*,iostat=ierror) a(i)%name,xtmp,ytmp,ztmp
	call lc2uc(a(i)%name(1:1)) !Convert to upper case
	call uc2lc(a(i)%name(2:2)) !Convert to lower case
	do j=0,nelesupp
		if ( a(i)%name==ind2name(j) ) then
			a(i)%index=j
			exit
		end if
	end do
    a(i)%x=xtmp/b2a
    a(i)%y=ytmp/b2a
    a(i)%z=ztmp/b2a
end do

close(10)

a%charge=a%index
a%name=ind2name(a%index)
call guessnelec
if (infomode==0) then
	write(*,"(' Totally',i8,' atoms')") ncenter
	!write(*,"(' The number of alpha and beta electrons:',2i8)") nint(naelec),nint(nbelec)
end if
end subroutine

!!----------------------------------------
!!------------- Read POSCAR of VASP
!See https://www.vasp.at/wiki/index.php/POSCAR for format description
subroutine readPOSCAR(name,infomode) !infomode=0 means output info, =1 silent
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode,anum(200)
character(len=*) name
character titleline*200,c200tmp*200,atype(200)*2,ctest
real*8 fract(3),Cart(3)

ifiletype=18
open(10,file=name,status="old")
read(10,"(a)") titleline
read(10,*) sclfac

read(10,*) cellv1
read(10,*) cellv2
read(10,*) cellv3
cellv1=cellv1*sclfac/b2a
cellv2=cellv2*sclfac/b2a
cellv3=cellv3*sclfac/b2a
ifPBC=3

!Test how many types
read(10,*)
read(10,"(a)") c200tmp
call numdatastr(c200tmp,ntype)
if (ntype>0) then !Element name is explicitly given
    backspace(10)
    backspace(10)
    read(10,*) atype(1:ntype) !Read element names
    read(10,*) anum(1:ntype) !Read number of atoms of each type
else !Element name is not explicitly given
    backspace(10)
    backspace(10)
    read(10,"(a)") c200tmp
    call numdatastr(c200tmp,ntype)
    read(c200tmp,*) anum(1:ntype)
    write(*,*) "Element name is not explicitly given in POSCAR, please manually input"
    do itype=1,ntype
        write(*,"(' Input element name for type',i3, ' ( Number of atoms is',i5,' )  e.g. Fe')") itype,anum(itype)
        read(*,*) atype(itype)
    end do
end if

read(10,*) ctest
if (ctest=="s".or.ctest=="S") then !The read line is selective dynamics, read next line for test coordinate type
    read(10,*) ctest
end if
icoord=0 !Assume to be "direct", namely fractional coordinate
if (ctest=='k'.or.ctest=='K'.or.ctest=='c'.or.ctest=='C') icoord=1 !Cartesian coordinate

ncenter=sum(anum(1:ntype))
if (allocated(a)) deallocate(a)
allocate(a(ncenter))

ncenter=0
do itype=1,ntype
    nthis=anum(itype)
    do iatm=ncenter+1,ncenter+nthis
        read(10,*) xtmp,ytmp,ztmp
        if (icoord==0) then !Fractional coordinate
            fract(1)=xtmp
            fract(2)=ytmp
            fract(3)=ztmp
            call fract2Cart(fract,Cart)
            a(iatm)%x=Cart(1)
            a(iatm)%y=Cart(2)
            a(iatm)%z=Cart(3)
        else if (icoord==1) then !Cartesian coordinate
            a(iatm)%x=xtmp/b2a
            a(iatm)%y=ytmp/b2a
            a(iatm)%z=ztmp/b2a
        end if
    end do
    !Assign element index
    call lc2uc(atype(itype)(1:1)) !Convert to upper case
	call uc2lc(atype(itype)(2:2)) !Convert to lower case
	do j=1,nelesupp
		if ( atype(itype)==ind2name(j) ) then
			a(ncenter+1:ncenter+nthis)%index=j
			exit
		end if
	end do
    ncenter=ncenter+nthis
end do

close(10)

a%charge=a%index
a%name=ind2name(a%index)
call guessnelec
if (infomode==0) then
    write(*,*) "Title line of this file:"
    write(*,"(a)") trim(titleline)
	write(*,"(' Totally',i8,' atoms')") ncenter
end if
end subroutine

!!----------------------------------------------------------------------------------
!!------------- Read grid data of VASP, CHGCAR/CHG/ELFCAR/LOCPOT files are supported
!CHGCAR/CHG (electron density multipled by cell volume) is outputted by VASP by default
!ELFCAR (ELF) can be generated by using LELF=.TRUE.
!LOCPOT can be generated by using LVTOT=.TRUE. If LVHAR=.TRUE., V_XC is not included, and the grid data &
!  corresponds to Hartree potential, namely negative of ESP. If LVHAR=.FALSE., the grid data corresponds to external potential in KS operator
!In spin polarized case (ISPIN=2), there are two sets of data:
!  CHGCAR/CHG records total density and spin density, ELFCAR records ELF for alpha and beta, LOCPOT records potential for alpha and beta
!See https://www.vasp.at/wiki/index.php/CHGCAR for format description
!Also see https://www.vasp.at/wiki/index.php/ELFCAR and https://www.vasp.at/wiki/index.php/LOCPOT
subroutine readVASPgrd(name,infomode) !infomode=0 means output info, =1 silent
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character c200tmp*200,c80tmp*80,selectyn

!The first part of CHGCAR/CHG is identical to POSCAR
call readPOSCAR(name,0)

ifiletype=7 !Same as cube

open(10,file=name,status="old")
do while(.true.)
    read(10,"(a)") c200tmp
    if (c200tmp==" ") exit
end do
read(10,*) nx,ny,nz
if (allocated(cubmat)) deallocate(cubmat)
allocate(cubmat(nx,ny,nz))
write(*,*) "Loading grid data..."
read(10,*) (((cubmat(ix,iy,iz),ix=1,nx),iy=1,ny),iz=1,nz)

!Check if there is second grid data
write(c80tmp,"(3i5)") nx,ny,nz
call loclabel(10,trim(c80tmp),ifound,0)
if (ifound==1) then
    write(*,*)
    if (index(name,"CHG")/=0) then
        write(*,"(a)") " This file also contains spin density, do you want to load it instead of loaded data (total density)? (y/n)"
    else if (index(name,"ELFCAR")/=0) then
        write(*,"(a)") " This file also contains ELF for beta electron, do you want to load it instead of loaded data (ELF for alpha electron)? (y/n)"
    else if (index(name,"LOCPOT")/=0) then
        write(*,"(a)") " This file also contains potential for beta electron, do you want to load it instead of potential for alpha electron? (y/n)"
    end if
    read(*,*) selectyn
    if (selectyn=='y'.or.selectyn=='Y') read(10,*) (((cubmat(ix,iy,iz),ix=1,nx),iy=1,ny),iz=1,nz)
end if

if (index(name,"CHG")/=0) then
    write(*,"(a)") " The CHGCAR/CHG file originally records rho*V_cell, do you want to convert it to rho? (y/n)"
    read(*,*) selectyn
    if (selectyn=='y'.or.selectyn=='Y') then
        call calc_cellvol(cellvol)
        cubmat=cubmat/cellvol
    end if
else if (index(name,"LOCPOT")/=0) then
    write(*,"(a)") " The LOCPOT file originally records potential felt by single electron, &
    do you want to convert it to electrostatic potential (taking negative of that)? (y/n)"
    read(*,*) selectyn
    if (selectyn=='y'.or.selectyn=='Y') cubmat=-cubmat
end if
close(10)

orgx=0
orgy=0
orgz=0
gridv1=cellv1/nx
gridv2=cellv2/ny
gridv3=cellv3/nz
dx=gridv1(1)
dy=gridv2(2)
dz=gridv3(3)
call getgridend !Generate endx,endy,endz
if (infomode==0) then
    call showgridinfo(1) !Calculate grid information
    call showgridinfo(2) !Calculate statistical information
end if
end subroutine

!!---------------------------------------------------------------------
!!----- The same as readVASPgrd, but only load grid data of CHGCAR/CHG, and the number of grid will be checked so that they are in agreement with cubmat
!inconsis is returned value, 1 means the grid setting of this cube file is inconsistent with that of cubmat
subroutine readVASPgrdtmp(name,inconsis)
use defvar
use util
implicit real*8 (a-h,o-z)
integer inconsis
character(len=*) name
character c200tmp*200,c80tmp*80,selectyn

!Direct locate to the first blank line and load grid data
open(10,file=name,status="old")
do while(.true.)
    read(10,"(a)") c200tmp
    if (c200tmp==" ") exit
end do
read(10,*) nxtmp,nytmp,nztmp

inconsis=0
if (nxtmp/=nx.or.nytmp/=ny.or.nztmp/=nz) then
	write(*,"(a)") " Error: The number of grid of this file is inconsistent with that of the grid data stored in memory!"
    write(*,*) "Press ENTER button to return"
    read(*,*)
	inconsis=1
    close(10)
	return
end if

if (allocated(cubmattmp)) deallocate(cubmattmp)
allocate(cubmattmp(nx,ny,nz))
write(*,*) "Loading grid data..."
read(10,*) (((cubmattmp(ix,iy,iz),ix=1,nx),iy=1,ny),iz=1,nz)

!Check if there is second grid data
write(c80tmp,"(3i5)") nx,ny,nz
call loclabel(10,trim(c80tmp),ifound,0)
if (ifound==1) then
    write(*,*)
    write(*,"(a)") " This file also contains spin density, do you want to load it instead of loaded data (total density)? (y/n)"
    read(*,*) selectyn
    if (selectyn=='y'.or.selectyn=='Y') read(10,*) (((cubmattmp(ix,iy,iz),ix=1,nx),iy=1,ny),iz=1,nz)
end if

if (index(name,"CHG")/=0) then
    write(*,"(a)") " The CHGCAR/CHG file originally records rho*V_cell, do you want to convert it to rho? (y/n)"
    read(*,*) selectyn
    if (selectyn=='y'.or.selectyn=='Y') then
        call calc_cellvol(cellvol)
        cubmattmp=cubmattmp/cellvol
    end if
end if
close(10)

end subroutine

!!------------------- Read MDL .mol file (V2000) -------------------
! Format description: https://en.wikipedia.org/wiki/Chemical_table_file
! infomode=0: Output summary, =1: do not
subroutine readmol(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
ifiletype=11
open(10,file=name,status="old")
read(10,"(a)") titleline
read(10,*)
read(10,*)
read(10,"(2i3)") ncenter,nbond
if (allocated(a)) deallocate(a)
allocate(a(ncenter))
do i=1,ncenter
	read(10,*) a(i)%x,a(i)%y,a(i)%z,a(i)%name
	call lc2uc(a(i)%name(1:1)) !Convert to upper case
	call uc2lc(a(i)%name(2:2)) !Convert to lower case
	do j=1,nelesupp
		if ( a(i)%name==ind2name(j) ) then
			a(i)%index=j
			exit
		end if
	end do
end do
if (allocated(connmat)) deallocate(connmat)
allocate(connmat(ncenter,ncenter))
connmat=0
do ibond=1,nbond
	read(10,"(3i3)") i,j,ntmp
	connmat(i,j)=ntmp
	connmat(j,i)=ntmp
end do
close(10)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
a%charge=a%index
if (infomode==0) write(*,"(' Totally',i8,' atoms')") ncenter
call guessnelec
end subroutine

!------------- Only read connectivity from .mol file -----------------
subroutine readmolconn(name)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) name
open(10,file=name,status="old")
read(10,*)
read(10,*)
read(10,*)
read(10,"(2i3)") ntmp,nbond
do i=1,ntmp
	read(10,*)
end do
if (allocated(connmat)) deallocate(connmat)
allocate(connmat(ncenter,ncenter))
connmat=0
do ibond=1,nbond
	read(10,"(3i3)") i,j,ntmp
	connmat(i,j)=ntmp
	connmat(j,i)=ntmp
end do
close(10)
end subroutine

!!------------------- Read .mol2 file -------------------
! infomode=0: Output summary, =1: do not
subroutine readmol2(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character c80tmp*80
ifiletype=13
open(10,file=name,status="old")
call loclabel(10,"@<TRIPOS>MOLECULE")
read(10,*)
read(10,"(a)") titleline
read(10,*) ncenter,nbond

if (allocated(a)) deallocate(a)
allocate(a(ncenter))
call loclabel(10,"@<TRIPOS>ATOM")
read(10,*)
do i=1,ncenter
	read(10,*) inouse,c80tmp,a(i)%x,a(i)%y,a(i)%z,a(i)%name
	ico=index(a(i)%name,'.')
	if (ico/=0) a(i)%name(ico:)=" "
	call lc2uc(a(i)%name(1:1)) !Convert to upper case
	call uc2lc(a(i)%name(2:2)) !Convert to lower case
	do j=1,nelesupp
		if ( a(i)%name==ind2name(j) ) then
			a(i)%index=j
			exit
		end if
	end do
end do

if (allocated(connmat)) deallocate(connmat)
allocate(connmat(ncenter,ncenter))
call loclabel(10,"@<TRIPOS>BOND")
read(10,*)
connmat=0
!gview records aromatic carbon as type of 4 in .mol, but record it as Ar
!When loading such kind of atom, Multiwfn still recognize it as type 4
do ibond=1,nbond
	read(10,*) inouse,i,j,c80tmp
	if (c80tmp=="ar".or.c80tmp=="Ar") then
		ntmp=4
	else if (c80tmp=="am") then
		ntmp=1
	else if (c80tmp=="un".or.c80tmp=="nc".or.c80tmp=="du") then
		ntmp=0
	else
		read(c80tmp,*) ntmp
	end if
	connmat(i,j)=ntmp
	connmat(j,i)=ntmp
end do

call loclabel(10,"@<TRIPOS>CRYSIN",ifound)
if (ifound==1) then
    ifPBC=3
    read(10,*)
    read(10,*) asize,bsize,csize,alpha,beta,gamma
    asize=asize/b2a
    bsize=bsize/b2a
    csize=csize/b2a
    call abc2cellv(asize,bsize,csize,alpha,beta,gamma)
end if

close(10)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
a%charge=a%index
if (infomode==0) write(*,"(' Totally',i8,' atoms')") ncenter
call guessnelec
end subroutine

!!-----------------------------------------------------------------
!! Read .31 and one of .32 to .40 file generated by NBO program
!! After loading, only GTF information is yielded, while basis functions are discarded
subroutine read31(name,infomode) !mode=0 means output wfn property,=1 not
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) name
character :: name2*200=" ",chartemp*80,tmpc2*2
integer infomode
integer bastype2func(500) !Convert basis type in NBO (NBO5.0 Program Manual P103) to function type in .wfn
integer,allocatable :: shellcon(:),shell2atom(:),shellnumbas(:),shell2prmshl(:),bastype31(:),shellnumbas5D(:)
integer bastype_p(3) !The NBO plot file outputted by ORCA+NBO use special order of p shell, therefore record actual order and use later
real*8,allocatable :: orbcoeff(:,:),prmshlexp(:),cs(:),cp(:),cd(:),cf(:),cg(:),orbcoeff5D(:,:)
real*8 :: conv5d6d(6,5)=0D0,conv7f10f(10,7)=0D0,conv9g15g(15,9)=0D0
real*8,external :: normgau
ifiletype=6
bastype2func(1)=1 !s
bastype2func(101)=2 !x
bastype2func(102)=3 !y
bastype2func(103)=4 !z
bastype2func(201)=5 !xx
bastype2func(202)=8 !xy
bastype2func(203)=9 !xz
bastype2func(204)=6 !yy
bastype2func(205)=10 !yz
bastype2func(206)=7 !zz
bastype2func(301)=11 !xxx
bastype2func(302)=14 !xxy
bastype2func(303)=15 !xxz
bastype2func(304)=17 !xyy
bastype2func(305)=20 !xyz
bastype2func(306)=18 !xzz
bastype2func(307)=12 !yyy
bastype2func(308)=16 !yyz
bastype2func(309)=19 !yzz
bastype2func(310)=13 !zzz
!Below g sequence comes from line 47384 in NBO_5 src
bastype2func(401)=35 !XXXX
bastype2func(402)=34 !XXXY
bastype2func(403)=33 !XXXZ
bastype2func(404)=32 !XXYY
bastype2func(405)=31 !XXYZ
bastype2func(406)=30 !XXZZ
bastype2func(407)=29 !XYYY
bastype2func(408)=28 !XYYZ
bastype2func(409)=27 !XYZZ
bastype2func(410)=26 !XZZZ
bastype2func(411)=25 !YYYY
bastype2func(412)=24 !YYYZ
bastype2func(413)=23 !YYZZ
bastype2func(414)=22 !YZZZ
bastype2func(415)=21 !ZZZZ
!Conversion relationship used below can be found in http://sobereva.com/97
!Used to convert coefficient matrix from 5D to 6D
!5D sequence in .31: 255   252   253   254   251
!namely -0.5*XX-0.5*YY+ZZ, XZ, YZ, √3/2*(XX-YY), XY
!to 6D: XX,XY,XZ,YY,YZ,ZZ, namely 201~206, the indexes are consecutive
conv5d6d(1,1)=-0.5D0
conv5d6d(4,1)=-0.5D0
conv5d6d(6,1)=1D0
conv5d6d(3,2)=1D0
conv5d6d(5,3)=1D0
conv5d6d(1,4)=sqrt(3D0)/2D0
conv5d6d(4,4)=-sqrt(3D0)/2D0
conv5d6d(2,5)=1D0
!Used to convert coefficient matrix from 7F to 10F, Standard f set
!7F sequence in .31: 351   352   353   354   355   356   357
!to 10F: XXX,XXY,XXZ,XYY,XYZ,XZZ,YYY,YYZ,YZZ,ZZZ, namely 301~310, the indexes are consecutive
conv7f10f(3,1)=-0.721962098225322D0
conv7f10f(8,1)=-0.721962098225322D0
conv7f10f(10,1)=0.481308065483548D0
conv7f10f(1,2)=-0.281160203343101D0
conv7f10f(4,2)=-0.281160203343101D0
conv7f10f(6,2)=1.1246408133724D0
conv7f10f(2,3)=-0.281160203343101D0
conv7f10f(7,3)=-0.281160203343101D0
conv7f10f(9,3)=1.1246408133724D0
conv7f10f(3,4)=sqrt(3D0)/2D0
conv7f10f(8,4)=-sqrt(3D0)/2D0
conv7f10f(5,5)=1D0
conv7f10f(1,6)=0.369693511996758D0
conv7f10f(4,6)=-1.10908053599027D0
conv7f10f(2,7)=1.10908053599027D0
conv7f10f(7,7)=-0.369693511996758D0

write(*,*) "Input filename with suffix ranging from .32 to .40 (e.g. ltwd.35)"
write(*,*) "Note: 32=PNAO 33=NAO 34=PNHO 35=NHO 36=PNBO 37=NBO 38=PNLMO 39=NLMO 40=MO"
do while(.true.)
	read(*,"(a)") name2
	if (name2(1:2)=="32".or.name2(1:2)=="33".or.name2(1:2)=="34".or.name2(1:2)=="35"&
	.or.name2(1:2)=="36".or.name2(1:2)=="37".or.name2(1:2)=="38".or.name2(1:2)=="39".or.name2(1:2)=="40") then
		tmpc2=name2(1:2)
		name2(1:len(name))=name
		name2(len_trim(name2)-1:len_trim(name2))=tmpc2
	end if
	inquire(file=name2,exist=alive)
	if (alive.eqv..true.) exit
	write(*,*) "File not found, input again"
end do

itmplen=len_trim(name2)
if (name2(itmplen-1:itmplen)=="32") write(*,*) "Loading .32 file(PNAO)"
if (name2(itmplen-1:itmplen)=="33") write(*,*) "Loading .33 file(NAO)"
if (name2(itmplen-1:itmplen)=="34") write(*,*) "Loading .34 file(PNHO)"
if (name2(itmplen-1:itmplen)=="35") write(*,*) "Loading .35 file(NHO)"
if (name2(itmplen-1:itmplen)=="36") write(*,*) "Loading .36 file(PNBO)"
if (name2(itmplen-1:itmplen)=="37") write(*,*) "Loading .37 file(NBO)"
if (name2(itmplen-1:itmplen)=="38") write(*,*) "Loading .38 file(PNLMO)"
if (name2(itmplen-1:itmplen)=="39") write(*,*) "Loading .39 file(NLMO)"
if (name2(itmplen-1:itmplen)=="40") write(*,*) "Loading .40 file(MO)"
open(10,file=name,status="old")
read(10,*)
read(10,*)
read(10,*)
read(10,*) ncenter,nshell,nprimshell
allocate(a(ncenter),shellcon(nshell),shell2atom(nshell),shellnumbas(nshell),shell2prmshl(nshell))
allocate(prmshlexp(nprimshell),cs(nprimshell),cp(nprimshell),cd(nprimshell),cf(nprimshell),cg(nprimshell))
allocate(bastype31(nshell*15)) !We don't know how many basis before read the file, so use the maximum value(up to g function)
read(10,*)
do i=1,ncenter
	read(10,*,iostat=ierror) a(i)%index,a(i)%x,a(i)%y,a(i)%z
    if (ierror/=0) then
        write(*,"(a,i5,a)") " Error: Coordinate of atom",i," cannot be normally loaded!"
        write(*,"(a)") " Please open .31 file by text editor and check if coordinate of this atom (and may be other ones) is ******. &
        If yes, you should manually replace it with actual coordinate"
        write(*,*) "Press ENTER button to exit"
        read(*,*)
        stop
    end if
	a(i)%charge=a(i)%index !.31 doesn't record charge and index separately, so we have to make them indentical
end do
a%name=ind2name(a%index)
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
read(10,*)
j=1
do i=1,nshell
	read(10,*) shell2atom(i),shellnumbas(i),shell2prmshl(i),shellcon(i)
	read(10,*) bastype31(j:j+shellnumbas(i)-1)
    if (shellnumbas(i)==3) bastype_p(1:3)=bastype31(j:j+shellnumbas(i)-1) !Record actual order of p shell
	j=j+shellnumbas(i)
end do
isphergau=0
if (any(bastype31==251).or.any(bastype31==351).or.any(bastype31==451)) isphergau=1
!The conversion relationship between Cartesian and pure functions used by NBO is different to mainstream quantum chemistry code, the relationship for f is documented
!in the NBO manual, however there is no way to find out that for g-type. So if g-type is involved, Cartesian type must be used.
if (any(bastype31==451)) then
	write(*,"(a)") " Error: Multiwfn does not support spherical harmonic Gaussian functions with g or higher angular moment in NBO plot files. &
	If you used Gaussian to generate them, you should add ""6d 10f"" keywords and regenerate these files"
	write(*,*) "Press ENTER button to exit"
	read(*,*)
	stop
end if
read(10,*)
read(10,*) prmshlexp
read(10,*)
read(10,*) cs
read(10,*)
read(10,*) cp
read(10,*)
read(10,*) cd
read(10,*)
read(10,*) cf
read(10,"(a)",iostat=ierror) chartemp
if (ierror==0) then
	backspace(10)
	read(10,*) cg
end if
close(10)

totenergy=0D0
virialratio=0D0
nbasis=sum(shellnumbas) !Calculate the number of basis
write(*,"(' Expected number of basis functions:',i10)") nbasis
open(10,file=name2,status="old")
read(10,*)
read(10,*)
read(10,*)
read(10,"(a)") chartemp
naelec=0D0
nbelec=0D0
!Note: When diffuse functions are used, although the number of AO in NBO plot files are always identical to nbasis, &
!the number of NAOs and thus the resulting NBOs etc. may be smaller than nbasis (and can also be different to Nbsuse in Gaussian output file)
!"nload" is used to test how many frames (orbitals) can be normally loaded
if (chartemp(1:11)==" ALPHA SPIN".or.chartemp(1:11)==" alpha spin") then
	wfntype=4
	nmo=2*nbasis
	allocate(orbcoeff(nbasis,nmo),MOocc(nmo),MOene(nmo),MOtype(nmo))
	MOtype(1:nbasis)=1 !alpha
	MOtype(nbasis+1:nmo)=2 !beta
	orbcoeff=0
	MOocc=0
	nload=0
	do iorb=1,nbasis !Note that the occupation section may be erronesouly loaded as orbital coefficient here when linear dependency problem occur
		read(10,"(1x,5f15.9)",iostat=ierror) orbcoeff(1:nbasis,iorb)
		if (ierror/=0) exit
		nload=nload+1
	end do
	if (name2(itmplen-1:itmplen)=="37".or.name2(itmplen-1:itmplen)=="39") then !Need to load occupation
		if (nload/=nbasis) then
			write(*,"(/,a)") " Warning: The number of orbitals is smaller than basis functions! This is often because diffuse functions are used. &
			Please now input the actual number of NAOs (you can easily find it from output of NBO program), e.g. 374"
            write(*,"(' If you really do not know how to input, try to input',i6)") nload
			read(*,*) nNAOs
			call loclabel(10,chartemp(1:11))
			read(10,*)
			do iorb=1,nNAOs
				read(10,*) orbcoeff(1:nbasis,iorb)
			end do
			orbcoeff(1:nbasis,nNAOs+1:nbasis)=0
		else
			nNAOs=nbasis
		end if
        !write(*,*) nNAOs,nload,nbasis
		read(10,*) MOocc(1:nNAOs)
	end if
	if (chartemp(1:11)==" ALPHA SPIN") then
		call loclabel(10," BETA  SPIN",ifound)
	else
		call loclabel(10," beta  spin",ifound)
	end if
	if (ifound==1) then
		read(10,*)
		do iorb=nbasis+1,nbasis+nNAOs
			read(10,*) orbcoeff(1:nbasis,iorb)
		end do
		if (name2(itmplen-1:itmplen)=="37".or.name2(itmplen-1:itmplen)=="39") read(10,*) MOocc(nbasis+1:nbasis+nNAOs)
	else
		write(*,*) "Warning: Beta-spin information are not found in this file!"
		write(*,*)
	end if
	naelec=sum(MOocc(1:nbasis))
	nbelec=sum(MOocc(nbasis+1:nmo))
	nelec=naelec+nbelec
else !Close shell system
	wfntype=3
	nmo=nbasis
	allocate(orbcoeff(nbasis,nmo),MOocc(nmo),MOene(nmo),MOtype(nmo))
	MOtype=0
	orbcoeff=0
	MOocc=0
	nload=0
	backspace(10)
	do iorb=1,nmo
		read(10,"(1x,5f15.9)",iostat=ierror) orbcoeff(1:nbasis,iorb)
        !if (ierror/=0) write(*,"(5f15.9)") orbcoeff(1:nbasis,iorb)
		if (ierror/=0) exit
		nload=nload+1
	end do
    !write(*,*) nload,nbasis
	if (name2(itmplen-1:itmplen)=="37".or.name2(itmplen-1:itmplen)=="39") then
		if (nload/=nbasis) then
			write(*,"(/,a)") " Warning: The number of orbitals is smaller than basis functions! This is often because diffuse functions are used. &
			Please now input the actual number of NAOs (you can easily find it from output of NBO program), e.g. 374"
            write(*,"(' If you really do not know how to input, try to input',i6)") nload
			read(*,*) nNAOs
            rewind(10)
            read(10,*)
            read(10,*)
            read(10,*)
			do iorb=1,nNAOs
				read(10,*) orbcoeff(1:nbasis,iorb)
			end do
			orbcoeff(1:nbasis,nNAOs+1:nbasis)=0
		else
			nNAOs=nbasis
		end if
		read(10,*) MOocc(1:nNAOs)
	end if
	nelec=sum(MOocc)
	naelec=nelec/2
	nbelec=naelec
end if
close(10)
MOene=0D0

!Temporarily convert spherical harmonic Gaussian functions' information to Cartesian type
if (isphergau==1) then
	!Calculate how many Cartesian basis after conversion
	nbasis5D=nbasis
	nbasis=0
	do i=1,nshell
		if (shellnumbas(i)==5) then !D
			nbasis=nbasis+6
		else if (shellnumbas(i)==7) then !F
			nbasis=nbasis+10
		else if (shellnumbas(i)==9) then !G
			nbasis=nbasis+15
		else !S,P,SP, or Cartesian shells
			nbasis=nbasis+shellnumbas(i)
		end if
	end do
	allocate(shellnumbas5D(nshell))
	shellnumbas5D=shellnumbas !Backup
	where(shellnumbas==5) shellnumbas=6 !Convert number of orbitals in each shell from 5D to Cartesian type
	where(shellnumbas==7) shellnumbas=10
	where(shellnumbas==9) shellnumbas=15

	allocate(orbcoeff5D(nbasis5D,nmo))
	orbcoeff5D=orbcoeff !Backup
	deallocate(orbcoeff)
	allocate(orbcoeff(nbasis,nmo)) !Enlarge size from spherical type to Cartesian type
	orbcoeff=0D0

	deallocate(bastype31)
	allocate(bastype31(nbasis)) !Enlarge size from spherical type to Cartesian type

	!Generate Cartesian .31 basis type, the indexes are consecutive, in line with conv5d6d and conv7f10f
	i=1
	do ish=1,nshell
		if (shellnumbas(ish)==1) then !s
			bastype31(i)=1
		else if (shellnumbas(ish)==3) then !p
            bastype31(i:i+2)=bastype_p(:)
		else if (shellnumbas(ish)==4) then !sp
			bastype31(i)=1
			bastype31(i+1)=101
			bastype31(i+2)=102
			bastype31(i+3)=103
		else if (shellnumbas(ish)==6) then !d
			do j=1,6
				bastype31(i+j-1)=200+j
			end do
		else if (shellnumbas(ish)==10) then !f
			do j=1,10
				bastype31(i+j-1)=300+j
			end do
		else if (shellnumbas(ish)==15) then !g
			do j=1,15
				bastype31(i+j-1)=400+j
			end do
		end if
		i=i+shellnumbas(ish)
	end do

	!Map 5D coefficient to 6D coefficient
	ipos5D=1
	ipos6D=1
	do ish=1,nshell
		n5D=shellnumbas5D(ish)
		n6D=shellnumbas(ish)
		if (n5D==1.or.n5D==3.or.n5D==4) then !S or P or SP
			if (wfntype==3) orbcoeff(ipos6D:ipos6D+n6D-1,1:nbasis5D)=orbcoeff5D(ipos5D:ipos5D+n5D-1,:)
			if (wfntype==4) orbcoeff(ipos6D:ipos6D+n6D-1,1:2*nbasis5D)=orbcoeff5D(ipos5D:ipos5D+n5D-1,:)
		else if (n5D==5) then
			!5D->6D
			if (wfntype==3) orbcoeff(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,orbcoeff5D(ipos5D:ipos5D+4,:))
			if (wfntype==4) orbcoeff(ipos6D:ipos6D+5,1:2*nbasis5D)=matmul(conv5d6d,orbcoeff5D(ipos5D:ipos5D+4,:))
		else if (n5D==7) then
			!7F->10F
			if (wfntype==3) orbcoeff(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,orbcoeff5D(ipos5D:ipos5D+6,:))
			if (wfntype==4) orbcoeff(ipos6D:ipos6D+9,1:2*nbasis5D)=matmul(conv7f10f,orbcoeff5D(ipos5D:ipos5D+6,:))
		else if (n5D==9) then
			!9G->15G
			if (wfntype==3) orbcoeff(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,orbcoeff5D(ipos5D:ipos5D+8,:))
			if (wfntype==4) orbcoeff(ipos6D:ipos6D+14,1:2*nbasis5D)=matmul(conv9g15g,orbcoeff5D(ipos5D:ipos5D+8,:))
		end if
		ipos5D=ipos5D+n5D
		ipos6D=ipos6D+n6D
	end do
end if

nprims=0
do i=1,nshell
	nprims=nprims+shellcon(i)*shellnumbas(i)
end do
allocate(b(nprims),CO(nmo,nprims))

iGTF=1 !current GTF index
ibasis=1
do i=1,nshell !cycle each shell
	b(iGTF:iGTF+shellcon(i)*shellnumbas(i)-1)%center=shell2atom(i)
	do j=1,shellnumbas(i) !cycle each basis function in each shell
		b(iGTF:iGTF+shellcon(i)-1)%type=bastype2func(bastype31(ibasis))
		do k=1,shellcon(i) !cycle each GTF in each basis in each shell
			iprmshlpos=shell2prmshl(i)+k-1
			b(iGTF)%exp=prmshlexp(iprmshlpos)
			if (bastype31(ibasis)==1) then !s
				contract=cs(iprmshlpos)
			else if (bastype31(ibasis)<=200) then !p
				contract=cp(iprmshlpos)
			else if (bastype31(ibasis)<=300) then !d
			!Contract coefficient in .31 contains normalization coefficient, however for d type, the
			!normalization coefficient is for XX,YY,ZZ, for XY,XZ,YZ, we need refresh normalization coefficient
				contract=cd(iprmshlpos)
				if (bastype31(ibasis)==202.or.bastype31(ibasis)==203.or.bastype31(ibasis)==205) then
					valnorm31=normgau(5,prmshlexp(iprmshlpos)) !Normalization coefficient for XX,YY,ZZ are identical
					valnormnew=normgau(8,prmshlexp(iprmshlpos)) !Normalization coefficient for XY,XZ,YZ are identical
					contract=contract/valnorm31*valnormnew
				end if
			else if (bastype31(ibasis)<=400) then !f
				contract=cf(iprmshlpos)
				!For f shell, in .31 normalization coefficient is for XXX,YYY,ZZZ, now refresh
				if (bastype31(ibasis)/=301.and.bastype31(ibasis)/=307.and.bastype31(ibasis)/=310) then !not XXX,YYY,ZZZ
					valnorm31=normgau(11,prmshlexp(iprmshlpos))
					if (bastype31(ibasis)==302.or.bastype31(ibasis)==303.or.bastype31(ibasis)==304&
					.or.bastype31(ibasis)==306.or.bastype31(ibasis)==308.or.bastype31(ibasis)==309) then
						valnormnew=normgau(14,prmshlexp(iprmshlpos)) !XXY,XXZ,XYY,XZZ,YYZ,YZZ are identical
					else if (bastype31(ibasis)==305) then
						valnormnew=normgau(20,prmshlexp(iprmshlpos)) !XYZ
					end if
					contract=contract/valnorm31*valnormnew
				end if
			else if (bastype31(ibasis)<=500) then !g
				contract=cg(iprmshlpos)
				!For g shell, in .31 normalization coefficient is for XXXX,YYYY,ZZZZ, now refresh
				!Note: I haven't verified that, since .37 outputted by NBO3.1 in Gaussian didn't contains g information
				nt=bastype31(ibasis) !now type
				if (nt/=401.and.nt/=411.and.nt/=415) then !not XXXX,YYYY,ZZZZ (4,0)
					valnorm31=normgau(21,prmshlexp(iprmshlpos))
					if (nt==402.or.nt==403.or.nt==407.or.nt==410.or.nt==412.or.nt==414) then
						valnormnew=normgau(22,prmshlexp(iprmshlpos)) !XXXY,XXXZ,XYYY,XZZZ,YYYZ,YZZZ (3,1)
					else if (nt==404.or.nt==406.or.nt==413) then
						valnormnew=normgau(23,prmshlexp(iprmshlpos)) !XXYY,XXZZ,YYZZ (2,2)
					else if (nt==405.or.nt==408.or.nt==409) then
						valnormnew=normgau(27,prmshlexp(iprmshlpos)) !XYZZ,XYYZ,XXYZ (2,1,1)
					end if
					contract=contract/valnorm31*valnormnew
				end if
			end if
			CO(:,iGTF)=orbcoeff(ibasis,:)*contract
			iGTF=iGTF+1
		end do
		ibasis=ibasis+1
	end do
end do
nbasisCar=nbasis
if (isphergau==1) nbasis=nbasis5D

if (infomode==0) then
	if (name2(itmplen-1:itmplen)=="37".or.name2(itmplen-1:itmplen)=="39") write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Atoms:',i6,',  Basis functions:',i6,',  Orbitals:',i6,',  GTFs:',i6)") ncenter,nbasis,nmo,nprims
	if (wfntype==3) write(*,*) " This is closed-shell system"
	if (wfntype==4) then
		write(*,*) " This is open-shell system"
		write(*,"(' Orbitals from 1 to',i6,' are alpha, from',i6,' to',i6,' are beta')") nbasis,nbasis+1,nmo
	end if
	write(*,*)
end if
end subroutine

!!-----------------------------------------------------------------
!!---------------- Read Gaussian cube file and store in cubmat
!infomode=0 means output cube details, =1 do not, =2 also do not print loading process
!ionlygrid=1 means only read grid data, but do not perturb atom information, =0 means do all
subroutine readcube(cubname,infomode,ionlygrid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) cubname
character*79 titleline1,titleline2
integer infomode,ionlygrid
integer,allocatable :: mo_serial(:)
real*8,allocatable :: temp_readdata(:),tmpreadcub(:,:,:)
if (ionlygrid==0) ifiletype=7
open(10,file=cubname,status="old")
read(10,"(a)") titleline1
read(10,"(a)") titleline2
read(10,*) ncentertmp,orgx,orgy,orgz
read(10,*) nx,gridv1
read(10,*) ny,gridv2
read(10,*) nz,gridv3
if (ionlygrid==0) ncenter=ncentertmp
dx=gridv1(1)
dy=gridv2(2)
dz=gridv3(3)
call getgridend !Generate endx,endy,endz

mo_number=0
if (ncenter<0) then
	mo_number=1 !This cube file contains at least one MO data
	ncenter=abs(ncenter)
end if
if (ionlygrid==0) then
	if (allocated(a)) deallocate(a)
	allocate(a(ncenter))
end if
if (allocated(cubmat)) deallocate(cubmat)
allocate(cubmat(nx,ny,nz))

if (infomode==0) then
    write(*,*)
	write(*,*) "Title line of this file:"
	write(*,"(a)") trim(titleline1)
	write(*,"(a)") trim(titleline2)
	write(*,"(/,' Total number of atoms:',i8)") ncenter
    call showgridinfo(1)
end if

if (ionlygrid==0) then
	do i=1,ncenter
		read(10,*) a(i)%index,a(i)%charge,a(i)%x,a(i)%y,a(i)%z !%value is its charge, if ECP was used, it not equal to atomindex
	end do
	a%name=ind2name(a%index)
else if (ionlygrid==1) then
	do i=1,ncentertmp
		read(10,*) !Do not read atomic information, simply skip
	end do
end if
if (infomode<2) write(*,*)

if (mo_number==1) then
	read(10,"(i5)",advance="no") mo_number !Get actual number of MO
	if (mo_number>1) then
		allocate(mo_serial(mo_number))
		allocate(temp_readdata(nz*mo_number))
		read(10,*) mo_serial
		write(*,"(' There are ',i6,' MOs in this cube file, the serial numbers are: ')") mo_number
		do i=1,mo_number
			write(*,"(' Number ',i6,', corresponds to MO',i6)") i,mo_serial(i)
		end do
		write(*,*) "Which MO do you want to load? Input the serial number"
		do while(.true.)
			read(*,*) mo_select
			if (mo_select>0.and.mo_select<=mo_number) exit
			write(*,*) "Invalid input, input again"
		end do
	else
		read(10,*) !Only one MO, pass the MO serial line
	end if
end if

if (infomode<2) write(*,*) "Loading grid data, please wait..."
if (mo_number==0.or.mo_number==1) then !Commonly case, below code has the best compatibility
	allocate(tmpreadcub(nz,ny,nx))
	read(10,*) tmpreadcub(:,:,:)
	do i=1,nx
		do j=1,ny
			do k=1,nz
				cubmat(i,j,k)=tmpreadcub(k,j,i)
			end do
		end do
	end do
	deallocate(tmpreadcub)
else !Load specified of many orbitals
	ii=0
	do i=1,nx !a(x,y,z)
		do j=1,ny
			read(10,*) temp_readdata
			cubmat(i,j,:)=temp_readdata(mo_select:size(temp_readdata):mo_number)
		end do
		progress=dfloat(i)/nx*100
		if (progress>ii.and.infomode<2) then
			ii=ii+10
			write(*,"(f6.1,'%')") progress
		end if
	end do
	if (infomode<2) write(*,"(f6.1,'%')") 100D0
end if
close(10)

if (infomode==0) call showgridinfo(2) !Calculate statistical information
call guessnelec
end subroutine

!!-----------------------------------------------------------------
!!---- Read Gaussian cube file and save to cubmattmp, this is a simple version of readcube, can only be invoked after cubmat has been loaded
!don't read atomic information, don't modify loaded grid infomation such as nx/y/z,orgx/y/z...
!and don't output statistic information, don't specify coordinate for grid points...
!infomode=1: Print loading information, =2: do not print anything
!inconsis is returned value, 1 means the grid setting of this cube file is inconsistent with that of cubmat
subroutine readcubetmp(cubname,infomode,inconsis)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) cubname
integer inconsis
integer,allocatable :: mo_serial(:)
real*8,allocatable :: temp_readdata(:)
real*8 gridvectmp1(3),gridvectmp2(3),gridvectmp3(3)

open(10,file=cubname,status="old")
read(10,*)
read(10,*)
read(10,*) ncentertmp
read(10,*) nxtmp,gridvectmp1
read(10,*) nytmp,gridvectmp2
read(10,*) nztmp,gridvectmp3
inconsis=0
if (nxtmp/=nx.or.nytmp/=ny.or.nztmp/=nz.or.&
maxval(abs(gridv1-gridvectmp1))>0.005D0.or.maxval(abs(gridv2-gridvectmp2))>0.005D0.or.maxval(abs(gridv3-gridvectmp3))>0.005D0) then
	write(*,"(a)") " Error: The grid setting of this cube file is inconsistent with that of the grid data stored in memory!"
    write(*,*) "Press ENTER button to return"
    read(*,*)
	inconsis=1
	return
end if

mo_number=0
if (ncentertmp<0) then
	mo_number=1 !This cube file contains at least one MO data
	ncentertmp=abs(ncentertmp)
end if
if (allocated(cubmattmp)) deallocate(cubmattmp)
allocate(cubmattmp(nx,ny,nz)) !nx,ny,nz is identical to cubmat that already loaded into memory

do i=1,ncentertmp
	read(10,*) !Skip a(i)%index,a(i)%charge,a(i)%x,a(i)%y,a(i)%z !%value is its charge, if ECP was used, it not equal to atomindex
end do

if (mo_number==1) then
	read(10,"(i5)",advance="no") mo_number !Get actual number of MO
	if (mo_number>1) then
		allocate(mo_serial(mo_number))
		allocate(temp_readdata(nz*mo_number))
		read(10,*) mo_serial
		write(*,"(' There are ',i6,' MOs in this grid file, the serial number are: ')") mo_number
		do i=1,mo_number
			write(*,"(' Number ',i6,' : MO= ',i5)") i,mo_serial(i)
		end do
		write(*,*) "Which MO do you want to load? Input the serial number"
		do while(.true.)
			read(*,*) mo_select
			if (mo_select>0.and.mo_select<=mo_number) exit
			write(*,*) "Invalid input, input again"
		end do
	else
		read(10,*) !Only one MO, pass the MO serial line
	end if
end if

if (infomode<2) write(*,*)
if (infomode<2) write(*,*) "Loading grid data, please wait..."
!Load data
ii=0
do i=1,nx !a(x,y,z)
	do j=1,ny
		if (mo_number==0.or.mo_number==1) then
			read(10,*) cubmattmp(i,j,:)
		else !Load the specified MO from vast of MOs
			read(10,*) temp_readdata
			cubmattmp(i,j,:)=temp_readdata(mo_select:size(temp_readdata):mo_number)
		end if
	end do
	progress=dfloat(i)/nx*100
	if (progress>ii.and.infomode<2) then
		ii=ii+10
		write(*,"(f6.1,'%')") progress
	end if
end do
if (infomode<2) write(*,*) "Done!"
close(10)
end subroutine

!!-----------------------------------------------------------------
!!----------- Load .dx file (may be generated by volmap plugin in VMD)
!!infomode=0 means output dx details, =1 not
!ionlygrid=1 means only read grid data, but do not perturb any other variables, =0 means do all
subroutine readdx(dxname,infomode,ionlygrid)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) dxname
character c80tmp*80
integer infomode,ionlygrid
type(content) maxv,minv

open(10,file=dxname,status="old")
call loclabel(10,"counts")
read(10,"(a)") c80tmp
itmp=index(c80tmp,"counts")
read(c80tmp(itmp+6:),*) nx,ny,nz
call loclabel(10,"origin")
read(10,*) c80tmp,orgx,orgy,orgz
orgx=orgx/b2a
orgy=orgy/b2a
orgz=orgz/b2a
call loclabel(10,"delta")
read(10,*) c80tmp,gridv1(:)
read(10,*) c80tmp,gridv2(:)
read(10,*) c80tmp,gridv3(:)
gridv1=gridv1/b2a
gridv2=gridv2/b2a
gridv3=gridv3/b2a
dx=gridv1(1)
dy=gridv2(2)
dz=gridv3(3)
call getgridend !Generate endx,endy,endz

if (allocated(cubmat)) deallocate(cubmat)
allocate(cubmat(nx,ny,nz))
if (infomode==0) call showgridinfo(1)
write(*,*)
write(*,*) "Loading grid data, please wait..."
call loclabel(10,"object 3")
read(10,*)
read(10,*) (((cubmat(i,j,k),k=1,nz),j=1,ny),i=1,nx)
write(*,*) "Done!"
ifiletype=8
close(10)

if (infomode==0) call showgridinfo(2) !Show statistical information

end subroutine

!!-----------------------------------------------------------------
!!----------- Load Dmol3 .grd file, see format description in Material Studio help file
!infomode=0 means output grd details, =1 not
!ionlygrid=1 means only read grid data, but do not perturb any other variables, =0 means do all
subroutine readgrd(grdname,infomode,ionlygrid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) grdname
character*79 titleline
integer infomode,ionlygrid
type(content) maxv,minv
if (ionlygrid==0) ifiletype=8
open(10,file=grdname,status="old")
read(10,"(a)") titleline
read(10,*)
read(10,*) flenx,fleny,flenz,anga,angb,angc !Notice that the length unit is in Angstrom in .grd file
read(10,*) nx,ny,nz !Here nx,ny,nz are total spaces (between neighbour grid point) in each direction
read(10,*) ifast,ixback,ixforw,iyback,iyforw,izback,izforw
if (ifast/=1) then !ifast=1 means x varies fastest
	write(*,*) "Error: The first integer in the fifth line must be 1!"
    write(*,*) "Press ENTER button to exit"
	read(*,*)
	stop
end if
call abc2cellv(flenx/b2a,fleny/b2a,flenz/b2a,anga,angb,angc)
gridv1=cellv1/nx
gridv2=cellv2/ny
gridv3=cellv3/nz
dx=gridv1(1)
dy=gridv2(2)
dz=gridv3(3)
nx=nx+1 !Convert the number of spacings to the number of points
ny=ny+1
nz=nz+1
if (allocated(cubmat)) deallocate(cubmat)
allocate(cubmat(nx,ny,nz))
orgx=gridv1(1)*ixback+gridv2(1)*ixback+gridv3(1)*ixback
orgy=gridv1(2)*iyback+gridv2(2)*iyback+gridv3(2)*iyback
orgz=gridv1(3)*izback+gridv2(3)*izback+gridv3(3)*izback
call getgridend !Generate endx,endy,endz

if (infomode==0) then
	write(*,"(' Title line of this file: ',a)") trim(titleline)
	write(*,*)
	call showgridinfo(1)
end if
write(*,*)
write(*,*) "Loading grid data, please wait..."
ii=0
do k=1,nz   !a(x,y,z)
	do j=1,ny
		do i=1,nx
			read(10,*) cubmat(i,j,k)
		end do
	end do
	if (dfloat(k)/nz*100>ii) then
		ii=ii+10
		write(*,"(f6.1,'%')") dfloat(k)/nz*100
	end if
end do
write(*,"(f6.1,'%')") 100D0
write(*,*) "Done!"
close(10)

if (infomode==0) call showgridinfo(2) !Show statistical information
end subroutine

!!-----------------------------------------------------------------
!!----------- Load Dmol3 .grd file and save to cubmattmp
!inconsis is returned value, 1 means the grid setting of this cube file is inconsistent with that of cubmat
subroutine readgrdtmp(grdname,inconsis)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) grdname
open(10,file=grdname,status="old")
read(10,*)
read(10,*)
read(10,*)
read(10,*) nxtmp,nytmp,nztmp
read(10,*)
if (nxtmp+1/=nx.or.nytmp+1/=ny.or.nztmp+1/=nz) then
	write(*,"(a)") " Error: The grid setting of this grd file is inconsistent with that of the grid data stored in memory!"
	inconsis=1
	return
end if

if (allocated(cubmattmp)) deallocate(cubmattmp)
allocate(cubmattmp(nx,ny,nz))
write(*,*)
write(*,*) "Loading data, please wait..."
do k=1,nz
	do j=1,ny
		do i=1,nx
			read(10,*) cubmattmp(i,j,k)
		end do
	end do
end do
write(*,*) "Grid data loading completed!"
close(10)
end subroutine

!!---------------------------------------------------------------------
!!----------- Load vti file, which can be yielded by ParaView and GIMIC
!infomode=0 means output grd details, =1 not
!ionlygrid=1 means only read grid data, but do not perturb any other variables, =0 means do all
subroutine readvti(vtiname,infomode,ionlygrid)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) vtiname
character c1000tmp*1000
integer infomode,ionlygrid
type(content) maxv,minv
if (ionlygrid==0) ifiletype=8
open(10,file=vtiname,status="old")

call loclabel(10,"<ImageData")
call readxmlline(10,c1000tmp)
i=strcharpos(c1000tmp,'"',1)
j=strcharpos(c1000tmp,'"',2)
read(c1000tmp(i+1:j-1),*) ibeg,iend,jbeg,jend,kbeg,kend
nx=iend-ibeg+1
ny=jend-jbeg+1
nz=kend-kbeg+1
i=strcharpos(c1000tmp,'"',3)
j=strcharpos(c1000tmp,'"',4)
read(c1000tmp(i+1:j-1),*) orgx,orgy,orgz
i=strcharpos(c1000tmp,'"',5)
j=strcharpos(c1000tmp,'"',6)
read(c1000tmp(i+1:j-1),*) dx,dy,dz
gridv1=0;gridv2=0;gridv3=0
gridv1(1)=dx;gridv2(2)=dy;gridv3(3)=dz
call getgridend !Generate endx,endy,endz

if (allocated(cubmat)) deallocate(cubmat)
allocate(cubmat(nx,ny,nz))

if (infomode==0) call showgridinfo(1)
write(*,*)
write(*,*) "Loading grid data, please wait..."
call loclabel(10,"<DataArray")
call readxmlline(10,c1000tmp)
if (index(c1000tmp,"scalars")==0) then
    write(*,*) "Error: Only vti file recording scalar data is supported!"
    write(*,*) "Press ENTER button to exit program"
    read(*,*)
    stop
end if
read(10,*) (((cubmat(i,j,k),i=1,nx),j=1,ny),k=1,nz)
write(*,*) "Done!"
close(10)

!Perform statistic
maxv%value=cubmat(1,1,1)
maxv%x=orgx
maxv%y=orgy
maxv%z=orgz

if (infomode==0) call showgridinfo(2) !Show statistical information
end subroutine

!Return content enclosed by "<" in current line and the next ">" in a file of XML format. At most read 1000 characters
!Before invoking this routine, current position must be the line containing <
subroutine readxmlline(fileid,str)
character str*1000,c1000tmp2*1000
integer fileid,itmp,jtmp
read(fileid,"(a)") str
if (index(str,'>')==0) then
    do while(.true.)
        read(10,"(a)") c1000tmp2
        str=trim(str)//trim(c1000tmp2)
        if (index(c1000tmp2,'>')/=0) exit
    end do
end if
itmp=index(str,'<')
jtmp=index(str,'>')
str=str(itmp+1:jtmp-1)
end subroutine

!!-----------------------------------------------------------------
!!------------- Read .wfn file, infomode=0 means output wavefunction property and related information, =1 not
subroutine readwfn(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
CHARACTER(LEN=*) name
character*80 wfntitle,lastline,c80tmp*80
real*8,allocatable :: tmpCO(:,:),tmpMOocc(:),tmpMOene(:)
integer,allocatable :: tmpMOtype(:)
integer i,j,infomode
!Original .wfn format doesn't support g, however the .wfn outputted by Multiwfn, Molden2AIM and G09 since B.01 formally supports g
!Below is the g sequence used in Molden2AIM, .wfx, .molden and the .wfn outputted by Multiwfn and G09 since B.01
! 21 XXXX 22 YYYY 23 ZZZZ 24 XXXY 25 XXXZ
! 26 XYYY 27 YYYZ 28 XZZZ 29 YZZZ 30 XXYY
! 31 XXZZ 32 YYZZ 33 XXYZ 34 XYYZ 35 XYZZ
!Below is the g sequence internally used in Multiwfn, identical to .fch
! 21 ZZZZ 22 YZZZ 23 YYZZ 24 YYYZ 25 YYYY
! 26 XZZZ 27 XYZZ 28 XYYZ 29 XYYY 30 XXZZ
! 31 XXYZ 32 XXYY 33 XXXZ 34 XXXY 35 XXXX
! convGseq is used to convert g used in .wfn to the internal sequence of Multiwfn
! I assume that h sequence is identical to .wfx and Multiwfn
integer :: convGseq(35)=(/ (0,i=1,20), 35,25,21,34,33, 29,24,26,22,32, 30,23,31,28,27 /)
ifiletype=2
imodwfn=0
open(10,file=name,status="old")
read(10,"(a)") wfntitle
read(10,"(a8,i15,13x,i7,11x,i9)") c80tmp,nmo,nprims,ncenter
ibasmode=1
if (index(c80tmp,"SLATER")/=0) ibasmode=2
if (ibasmode==2) then
	write(*,"(a)") " Error: Multiwfn does not support the wfn file recording Slater type orbitals! Press ENTER button to exit"
	read(*,*)
	stop
end if
if (infomode==0.and.index(wfntitle,"Run Type")/=0) then
	write(*,"(a)") " Warning: It seems that this .wfn file was generated by ORCA. Notice that the .wfn file generated by ORCA is often non-standard, &
	and usually makes Multiwfn crash. Using .molden file as input file instead is recommended"
end if

allocate(a(ncenter))
allocate(b(nprims))
allocate(CO(nmo,nprims))
allocate(MOocc(nmo))
allocate(MOene(nmo))
allocate(MOtype(nmo))

do i=1,ncenter
	read(10,"(a24,3f12.8,10x,f5.1)") c80tmp,a(i)%x,a(i)%y,a(i)%z,a(i)%charge
	read(c80tmp,*) a(i)%name
	call lc2uc(a(i)%name(1:1))
	call uc2lc(a(i)%name(2:2))
	do j=0,nelesupp
		if (a(i)%name==ind2name(j)) then
			a(i)%index=j
			exit
		end if
		if (j==nelesupp) then
            if (infomode==0) then
			    write(*,"(/,3a,i5,'!')") " Warning: Found unknown element ",a(i)%name," with atom index of",i
			    write(*,*) "This atom now is recognized as Bq (ghost atom)"
            end if
			a(i)%index=0
            a(i)%name=ind2name(0)
		end if
	end do
end do
read(10,"(20x,20i3)") (b(i)%center,i=1,nprims)
read(10,"(20x,20i3)") (b(i)%type,i=1,nprims)
do i=1,nprims
	if (b(i)%type>=21.and.b(i)%type<=35) b(i)%type=convGseq(b(i)%type)
end do

!Read exponents
read(10,"(10x,5E14.7)") (b(i)%exp,i=1,nprims)

!From Gaussian09 B.01, if ECP is used, additional CENTER, TYPE, EXPONENTS field present to represent EDF(electron density functions) likewise .wfx file
!However such wfn file is foolish, the number of GTFs used to represent EDF is not explicitly recorded, so we must use trick to guess the number
!The coefficient of EDF is not written, how we use these EDF information? Obviously impossible! So we just skip these mad fields
read(10,"(a)") c80tmp
if (c80tmp(1:6)=="CENTRE") then
	call loclabel(10,"MO",ifound,0)
! 	ncenline=1
! 	do while(.true.) !Move to the first line of TYPE field, and count we passed how many rows (the number of lines of CENTER field)
! 		read(10,"(a)") c80tmp
! 		if (c80tmp(1:6)/="CENTRE") exit
! 		ncenline=ncenline+1
! 	end do
! 	backspace(10)
! 	backspace(10) !Return to the last line of CENTER field
! 	read(10,"(a)") c80tmp
! 	nEDFprims=(len_trim(c80tmp)-20)/3+(ncenline-1)*20
! 	do itmp=1,ncenline !Move to the first line of CENTER field, make ready to load EDF information
! 		backspace(10)
! 	end do
! 	allocate(b_EDF(nEDFprims),CO_EDF(nEDFprims))
! 	read(10,"(20x,20i3)") (b_EDF(i)%center,i=1,nEDFprims)
! 	read(10,"(20x,20i3)") (b_EDF(i)%type,i=1,nEDFprims)
! 	read(10,"(10x,5E14.7)") (b_EDF(i)%exp,i=1,nEDFprims)
else
	backspace(10)
end if

!Read orbitals
do i=1,nmo
	read(10,"(a)") c80tmp
	do ichar=1,80
		if (c80tmp(ichar:ichar)=='=') then
			read(c80tmp(ichar+1:),*) MOocc(i)
			exit
		end if
	end do
	do ichar=80,1,-1
		if (c80tmp(ichar:ichar)=='=') then
			read(c80tmp(ichar+1:),*) MOene(i)
			exit
		end if
	end do
! 	read(10,"(5E16.8)") (CO(i,j),j=1,nprims) ! Note: row/column of CO denote MO/basis function respectively, in contrary to convention
	read(10,"(5E16.8)") CO(i,:)
end do
read(10,*)
!Use free format to read in energy and virial to ensure compatibility
read(10,"(a)") lastline
iequalsign1=0
iequalsign2=0
do i=1,80
	if (lastline(i:i)=='=') then
		iequalsign1=i
		exit
	end if
end do
do i=80,1,-1
	if (lastline(i:i)=='=') then
		iequalsign2=i
		exit
	end if
end do
totenergy=0
virialratio=2
if (iequalsign1/=0) read(lastline(iequalsign1+1:),*) totenergy
if (iequalsign1==0) write(*,*) "Warning: Unable to find system energy in this file!"
if (iequalsign2/=0) read(lastline(iequalsign2+1:),*) virialratio
if (iequalsign2==0) write(*,*) "Warning: Unable to find Virial in this file!"
call loclabel(10,"$MOSPIN $END",ifoundmospin,0) !Also read spin-type from $MOSPIN $END field outputted by Molden2AIM since v2.0.5, if detected
if (ifoundmospin==1) then !Have defined spin-type explicitly, don't reset spin-type by guessing later
	if (infomode==0) write(*,*) "Note: Found $MOSPIN $END field, orbital spin-types are loaded"
	read(10,*)
	read(10,*) MOtype
	where (MOtype==3) MOtype=0
end if

! Load cell information if any. May be 1/2/3-dimension
call loclabel(10,"[Cell]",ifound)
if (ifound==0) call loclabel(10,"[cell]",ifound)
if (ifound==0) call loclabel(10,"[CELL]",ifound)
if (ifound==1) then
    read(10,*)
    read(10,*) cellv1
    ifPBC=1
    read(10,*,iostat=ierror) cellv2
    if (ierror/=0) then
        cellv2=0
    else
        ifPBC=ifPBC+1
        read(10,*,iostat=ierror) cellv3
        if (ierror/=0) then
            cellv3=0
        else
            ifPBC=ifPBC+1
        end if
    end if
    cellv1=cellv1/b2a
    cellv2=cellv2/b2a
    cellv3=cellv3/b2a
end if

close(10)

!Determine type of wavefunction
if (sum(MOocc)==2*nmo.and.all(int(MOocc)==MOocc)) then
	wfntype=0 !This is restricted wavefunction
	MOtype=0
else if (sum(MOocc)==nmo.and.all(int(MOocc)==MOocc)) then
	wfntype=1 !This is unrestricted wavefunction
	if (ifoundmospin==0) then
		MOtype=1 !Set all MO is alpha
		do i=2,nmo !if nmo=1, i will be set to 2, and no errors will appear
			if (MOene(i)<MOene(i-1)) exit
		end do
		MOtype(i:nmo)=2 !beta
	end if
else if (any(MOocc/=int(MOocc))) then
	if (nint(maxval(MOocc))==2) then !maximum occupation close to 2, so considered as restricted multiconfiguration wavefunction
		wfntype=3
		MOtype=0
	else
		wfntype=4 !This is unrestricted multiconfiguration wavefunction
		if (ifoundmospin==0) then
			MOtype=0
			do i=2,nmo
				if (MOocc(i)>MOocc(i-1)) then
					MOtype(1:i-1)=1
					MOtype(i:nmo)=2
					exit
				end if
			end do
		end if
	end if
else
	wfntype=2 !This is RO wavefunction
	MOtype=0
	do i=1,nmo
		if (MOocc(i)==1) MOtype(i)=1 !alpha
	end do
end if
!Count electrons
call updatenelec

!Sort orbitals so that the orbitals with same spin-type are contiguous, because the wfn file outputted by Molden2AIM is not always in line with this convention
if (ifoundmospin==1.and.(wfntype==1.or.wfntype==4)) then
	allocate(tmpCO(nmo,nprims),tmpMOtype(nmo),tmpMOocc(nmo),tmpMOene(nmo))
	ipos=0
	do itime=1,2
		do imo=1,nmo
			if ((itime==1.and.MOtype(imo)==1).or.(itime==2.and.MOtype(imo)==2)) then !Move alpha orbitals to tmp arrays
				ipos=ipos+1
				tmpCO(ipos,:)=CO(imo,:)
				tmpMOocc(ipos)=MOocc(imo)
				tmpMOene(ipos)=MOene(imo)
				tmpMOtype(ipos)=MOtype(imo)
			end if
		end do
	end do
	CO=tmpCO
	MOocc=tmpMOocc
	MOene=tmpMOene
	MOtype=tmpMOtype
	write(*,*) "Note: Sequence of orbitals has been sorted according to spin type"
	deallocate(tmpCO,tmpMOocc,tmpMOene,tmpMOtype)
end if

!Introduce EDF information
if (any(a%index/=nint(a%charge))) then
	if (isupplyEDF==0) then !Do nothing
		continue
	else if (isupplyEDF==2) then !Supply EDF from bulit-in library
		call readEDFlib(infomode)
	end if
end if

!Summary
if (infomode==0) then
	write(*,*)
	write(*,"(' Total energy:',f21.12,' Hartree,   Virial ratio:',f12.8)") totenergy,virialratio
	write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Net charge:',f12.5,'    Expected multiplicity:',i5)") sum(a(:)%charge)-nelec,nint(naelec-nbelec)+1
	write(*,"(' The number of orbitals:',i6,',  Atoms:',i7,',  GTFs:',i7)") nmo,ncenter,nprims
	if (wfntype==0) write(*,"(' This is a restricted closed-shell single-determinant wavefunction')")
	if (wfntype==1) write(*,"(' This is an unrestricted single-determinant wavefunction')")
	if (wfntype==2) write(*,"(' This is a restricted open-shell wavefunction')")
	if (wfntype==3) write(*,"(' This is a restricted multiconfiguration wavefunction')")
	if (wfntype==4) write(*,"(' This is an unrestricted multiconfiguration wavefunction')")
	if (wfntype==1.or.wfntype==4) then
		do i=1,nmo
			if (MOtype(i)==2) exit
		end do
		write(*,"(' Orbitals from 1 to',i6,' are alpha type, from',i6,' to',i6,' are beta type')") i-1,i,nmo
	end if
	write(*,"(' Title line of this file: ',a)") trim(wfntitle)
end if
end subroutine

!!-----------------------------------------------------------------
!!-------- Read .wfx. mode=0 means output related information, =1 Do not output
subroutine readwfx(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
CHARACTER(LEN=*) name
character spintype*20
integer infomode
!Below is the g sequence used in Molden2AIM, .wfx, .molden and the .wfn outputted by Multiwfn and G09 since B.01
! 21 XXXX 22 YYYY 23 ZZZZ 24 XXXY 25 XXXZ
! 26 XYYY 27 YYYZ 28 XZZZ 29 YZZZ 30 XXYY
! 31 XXZZ 32 YYZZ 33 XXYZ 34 XYYZ 35 XYZZ
!Below is the g sequence internally used in Multiwfn, identical to .fch
! 21 ZZZZ 22 YZZZ 23 YYZZ 24 YYYZ 25 YYYY
! 26 XZZZ 27 XYZZ 28 XYYZ 29 XYYY 30 XXZZ
! 31 XXYZ 32 XXYY 33 XXXZ 34 XXXY 35 XXXX
! convGseq is used to convert g used in .wfx to the internal sequence of Multiwfn
! PS: spdfh sequence in .wfx is identical to Multiwfn
integer :: convGseq(35)=(/ (0,i=1,20), 35,25,21,34,33, 29,24,26,22,32, 30,23,31,28,27 /)
ifiletype=3
imodwfn=0
open(10,file=name,status="old")
call loclabel(10,"<Number of Nuclei>")
read(10,*)
read(10,*) ncenter
if (allocated(a)) deallocate(a)
allocate(a(ncenter))
call loclabel(10,"<Number of Primitives>")
read(10,*)
read(10,*) nprims
allocate(b(nprims))
call loclabel(10,"<Number of Occupied Molecular Orbitals>")
read(10,*)
read(10,*) nmo
allocate(MOocc(nmo),MOene(nmo),MOtype(nmo),CO(nmo,nprims))
call loclabel(10,"<Nuclear Names>")
read(10,*)
read(10,*) a%name
do i=1,ncenter !Multiwfn does not allow number included in atom name
	if (iachar(a(i)%name(2:2))<=57.and.iachar(a(i)%name(2:2))>=48) a(i)%name(2:2)=' '
end do
call loclabel(10,"<Atomic Numbers>")
read(10,*)
read(10,*) a%index
call loclabel(10,"<Nuclear Charges>")
read(10,*)
read(10,*) a%charge
call loclabel(10,"<Nuclear Cartesian Coordinates>")
read(10,*)
read(10,*) ((a(i)%x,a(i)%y,a(i)%z),i=1,ncenter)
call loclabel(10,"<Number of Electrons>")
read(10,*)
read(10,*) nelec
call loclabel(10,"<Number of Alpha Electrons>")
read(10,*)
read(10,*) naelec
call loclabel(10,"<Number of Beta Electrons>")
read(10,*)
read(10,*) nbelec
call loclabel(10,"<Primitive Centers>")
read(10,*)
read(10,*) b%center
call loclabel(10,"<Primitive Types>")
read(10,*)
read(10,*) b%type
!The g sequence in .wfx is not identical to Multiwfn, convert them here
do i=1,nprims
	if (b(i)%type>=21.and.b(i)%type<=35) b(i)%type=convGseq(b(i)%type)
end do
call loclabel(10,"<Primitive Exponents>")
read(10,*)
read(10,*) b%exp
!------ Process EDF information
call loclabel(10,"<Number of EDF Primitives>",ifound)
if (ifound==1.and.readEDF==1) then
	write(*,*) "Loading electron density functions (EDF) field in this file..."
	read(10,*)
	read(10,*) nEDFprims
	allocate(b_EDF(nEDFprims),CO_EDF(nEDFprims))
	call loclabel(10,"<EDF Primitive Centers>")
	read(10,*)
	read(10,*) b_EDF%center
	call loclabel(10,"<EDF Primitive Types>")
	read(10,*)
	read(10,*) b_EDF%type !We assume all the type index is 1 (S type)
	if (maxval(b_EDF%type)>1) then
		write(*,*) "Error: All GTFs of electron density function must be S type! Press ENTER button to exit"
		read(*,*)
		stop
	end if
	call loclabel(10,"<EDF Primitive Exponents>")
	read(10,*)
	read(10,*) b_EDF%exp
	call loclabel(10,"<EDF Primitive Coefficients>")
	read(10,*)
	read(10,*) CO_EDF
	call loclabel(10,"<Number of Core Electrons>")
	read(10,*)
	read(10,*) nEDFelec
	if (infomode==0) write(*,"(a,i6,a)") " Note: EDF information represents",nEDFelec," inner-core electrons"
end if
call loclabel(10,"<Molecular Orbital Occupation Numbers>")
read(10,*)
read(10,*) MOocc
call loclabel(10,"<Molecular Orbital Energies>")
read(10,*)
read(10,*) MOene
call loclabel(10,"<Molecular Orbital Spin Types>")
read(10,*)
do i=1,nmo
	read(10,"(a20)") spintype
	if (adjustl(spintype)=="Alpha and Beta") MOtype(i)=0 !adjustl is needed, because the wfx outputted by ORCA is non-standard
	if (adjustl(spintype)=="Alpha") MOtype(i)=1
	if (adjustl(spintype)=="Beta") MOtype(i)=2
end do
call loclabel(10,"<Molecular Orbital Primitive Coefficients>")
read(10,*)
do i=1,nmo
	read(10,*)
	read(10,*)
	read(10,*)
	read(10,*) CO(i,:)
end do
call loclabel(10,"<Energy = T + Vne + Vee + Vnn>",ifound,0) !Don't rewind, otherwise Multiwfn will scan lots of information of MO field
read(10,*)
read(10,*) totenergy
call loclabel(10,"<Virial Ratio (-V/T)>",ifound,0)
read(10,*)
read(10,*) virialratio
close(10)

!Angular moment of GTF should be no higher than h
if (any(b%type>56)) then
	write(*,"(' Warning: Angular moment of one or more GTFs exceeds h, Multiwfn is unable to deal with this case! Its/their contributions will be discarded')")
	write(*,*) "Press ENTER button to continue"
	read(*,*)
	do iGTF=1,nprims
		if (b(iGTF)%type>56) then
			b(iGTF)%type=1 !Assume it is S type
			CO(:,iGTF)=0D0
		end if
	end do
end if

if ( all(MOocc==nint(MOocc)) ) then
	wfntype=2
	if (nmo==nint(nelec)) wfntype=1
	if (nmo==nint(nelec)/2) wfntype=0
else !post-HF
	if (naelec==nbelec) wfntype=3
	if (naelec/=nbelec) wfntype=4
end if

if (infomode==0) then
	write(*,*)
	write(*,"(' Total energy:',f21.12,' Hartree,   Virial ratio:',f12.8)") totenergy,virialratio
	write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Number of orbital:',i6,',  Atoms:',i7,',  GTFs:',i7)") nmo,ncenter,nprims
	if (wfntype==0) write(*,"(' This is restricted closed-shell single-determinant wavefunction')")
	if (wfntype==1) write(*,"(' This is unrestricted single-determinant wavefunction')")
	if (wfntype==2) write(*,"(' This is restricted open-shell wavefunction')")
	if (wfntype==3) write(*,"(' This is restricted multiconfiguration wavefunction')")
	if (wfntype==4) write(*,"(' This is unrestricted multiconfiguration wavefunction')")
	if (wfntype==1.or.wfntype==4) then
		do i=1,nmo
			if (MOtype(i)==2) exit
		end do
		write(*,"(' Orbitals from 1 to',i6,' are alpha type, from',i6,' to',i6,' are beta type')") i-1,i,nmo
	end if
	write(*,*)
end if
end subroutine

!!------- Load EDF information from external atomic .wfx files
subroutine readEDFatmwfx
use defvar
use util
implicit real*8 (a-h,o-z)
character elewfxfilename(110)*200,c200tmp*200
real*8,allocatable :: EDFCOtmp(:),EDFexptmp(:)
integer,allocatable :: EDFtypetmp(:)
integer atmsel(nelesupp,ncenter),natmsel(nelesupp)
iwfxtime=1
nEDFprims=0
nEDFelec=0
do while(.true.)
	write(*,*) "Load the inner-core density (EDF information) for which element? e.g. Fe"
	write(*,*) "You can also input atomic indices, e.g. 5,8-10,31 means selecting 5,8,9,10,31"
	write(*,*) "Note: If finished, input ""q"""
	read(*,"(a)") c200tmp
	itmp=ichar(c200tmp(1:1))
	if (c200tmp=='q') then
		exit
	else if (itmp>=48.and.itmp<=57) then !Inputted is atomic indices
		call str2arr(c200tmp,natmsel(iwfxtime),atmsel(iwfxtime,:))
	else !Inputted is element name
		call lc2uc(c200tmp(1:1)) !Make the first/second character in upper/lower case
		call uc2lc(c200tmp(2:2))
		natmsel(iwfxtime)=0
		do iatm=1,ncenter
			if (a(iatm)%name==c200tmp(1:2)) then
				natmsel(iwfxtime)=natmsel(iwfxtime)+1
				atmsel(iwfxtime,natmsel(iwfxtime))=iatm
			end if
		end do
	end if
	if (natmsel(iwfxtime)==0) then
		write(*,*) "No atoms are selected, input again"
		write(*,*)
	else if (natmsel(iwfxtime)>0) then
		write(*,"(' The number of atoms selected is',i7,',  including:')") natmsel(iwfxtime)
		write(*,"(12i6)") atmsel(iwfxtime,1:natmsel(iwfxtime))
		write(*,*)
		write(*,*) "Load EDF information from which file? e.g. C:\ltwd\Fe_lanl2.wfx"
		do while(.true.)
			read(*,*) elewfxfilename(iwfxtime)
			inquire(file=elewfxfilename(iwfxtime),exist=alive)
			if (alive) exit
			write(*,*) "Cannot find this file, input again"
		end do
		open(10,file=elewfxfilename(iwfxtime),status="old") !Count how many EDF GTFs in this file
		call loclabel(10,"<Number of EDF Primitives>",ifound)
		if (ifound==0) then
			write(*,*) "Error: Unable to find EDF information from this file!"
			cycle
		end if
		read(10,*)
		read(10,*) nEDFtmp
		call loclabel(10,"<Number of Core Electrons>")
		read(10,*)
		read(10,*) nEDFelectmp
		close(10)
		write(*,"(' The number of EDF primitives in this file is',i5,/)") nEDFtmp
		nEDFprims=nEDFprims+nEDFtmp*natmsel(iwfxtime)
		nEDFelec=nEDFelec+nEDFelectmp*natmsel(iwfxtime)
		iwfxtime=iwfxtime+1
	end if
end do
nwfxtime=iwfxtime-1
write(*,"(' The total number of EDF primitives is',i7)") nEDFprims
write(*,"(' The total number of inner-core electrons represented by EDF is',i8)") nEDFelec
allocate(b_EDF(nEDFprims),CO_EDF(nEDFprims))
ipos=1
do iwfxtime=1,nwfxtime
	open(10,file=elewfxfilename(iwfxtime),status="old")
	call loclabel(10,"<Number of EDF Primitives>",ifound)
	read(10,*)
	read(10,*) nEDFtmp
	allocate(EDFCOtmp(nEDFtmp),EDFexptmp(nEDFtmp),EDFtypetmp(nEDFtmp))
	call loclabel(10,"<EDF Primitive Types>")
	read(10,*)
	read(10,*) EDFtypetmp
	call loclabel(10,"<EDF Primitive Exponents>")
	read(10,*)
	read(10,*) EDFexptmp
	call loclabel(10,"<EDF Primitive Coefficients>")
	read(10,*)
	read(10,*) EDFCOtmp
	do iatm=1,natmsel(iwfxtime)
		b_EDF(ipos:ipos+nEDFtmp-1)%type=EDFtypetmp
		b_EDF(ipos:ipos+nEDFtmp-1)%exp=EDFexptmp
		b_EDF(ipos:ipos+nEDFtmp-1)%center=atmsel(iwfxtime,iatm)
		CO_EDF(ipos:ipos+nEDFtmp-1)=EDFCOtmp
		ipos=ipos+nEDFtmp
	end do
	deallocate(EDFCOtmp,EDFexptmp,EDFtypetmp)
	close(10)
end do
write(*,*) "The EDF information have been loaded"
end subroutine

!!------ Load EDF information from EDFlib provided by Zork
!See http://bbs.keinsci.com/forum.php?mod=viewthread&tid=5354 for description
!infomode=0/1 show/don't show info
subroutine readEDFlib(infomode)
use defvar
implicit real*8 (a-h,o-z)
real*8 EDFcoeff(100),EDFexp(100)
if (infomode==0) write(*,"(a)") " Loading electron density functions (EDF) information from &
built-in EDF library... The library is freely available at https://github.com/zorkzou/Molden2AIM"
nEDFprims=0
nEDFelec=0
!First time, find total number of EDF GTFs so that b_EDF and CO_EDF can be allocated
do iatm=1,ncenter
	natmcore=a(iatm)%index-nint(a(iatm)%charge)
	if (natmcore==0) cycle
	if (a(iatm)%index==0) cycle !Skip Bq
	nEDFelec=nEDFelec+natmcore
	call EDFLIB(a(iatm)%index,natmcore,nfun,EDFexp,EDFcoeff)
	if (infomode==0) write(*,"(1x,a,'(',i5,')      Core electrons:',i3,'     EDF primitive GTFs:',i3)") a(iatm)%name,iatm,natmcore,nfun
	if (nfun==0.and.infomode==0) then
		write(*,*) "Warning: Unable to find proper EDF information for this atom!"
		write(*,*) "Press Enter button to skip loading EDF information for this atom"
		read(*,*)
	end if
	nEDFprims=nEDFprims+nfun
end do
if (infomode==0) write(*,"(' The number of total inner-core electrons:',i6)") nEDFelec
if (infomode==0) write(*,"(' The number of total EDF primitive GTFs:',i6)") nEDFprims

allocate(b_EDF(nEDFprims),CO_EDF(nEDFprims))
ifun=0
b_EDF%type=0
do iatm=1,ncenter
	natmcore=a(iatm)%index-nint(a(iatm)%charge)
	if (natmcore==0) cycle
	call EDFLIB(a(iatm)%index,natmcore,nfun,EDFexp,EDFcoeff)
	if (nfun==0) cycle !Didn't find corresponding EDF information
	b_EDF(ifun+1:ifun+nfun)%exp=EDFexp(1:nfun)
	b_EDF(ifun+1:ifun+nfun)%center=iatm
	CO_EDF(ifun+1:ifun+nfun)=EDFcoeff(1:nfun)
	ifun=ifun+nfun
end do
if (infomode==0) write(*,*) " Loading EDF library finished!"
end subroutine

!!-----------------------------------------------------------------
!!--------- Read Molden input file, get coordinate, basis function and GTF information
!Known issue:
!CFour sometimes fail (e.g. benzene)
subroutine readmolden(name,infomode) !infomode=0 means output info, =1 silent
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) name
character c80*80,c80tmp*80,symtmp*10
integer,allocatable :: shelltype(:),shellcon(:),shell2atom(:) !The definition of shelltype is identical to .fch
integer :: s2f(-5:5,21)=0 !Give shell type & orbital index to get functype
real*8,allocatable :: primexp(:),concoeff(:)
real*8,allocatable :: amocoeff(:,:),bmocoeff(:,:)
real*8 conv5d6d(6,5),conv7f10f(10,7),conv9g15g(15,9),conv11h21h(21,11)
!For backing up spherical basis functions
integer,allocatable :: shelltype5D(:),MOtype5D(:)
character*4,allocatable :: MOsym5D(:)
real*8,allocatable :: CObasa5D(:,:),CObasb5D(:,:),MOene5D(:),MOocc5D(:),CO5D(:,:)
real*8,external :: normgau
ifiletype=9
imodwfn=0
s2f(-5,1:11)=(/ -32,-31,-30,-29,-28,-27,-26,-25,-24,-23,-22 /)
s2f(-4,1:9)=(/ -21,-20,-19,-18,-17,-16,-15,-14,-13 /)
s2f(-3,1:7)=(/ -12,-11,-10,-9,-8,-7,-6 /)
s2f(-2,1:5)=(/ -5,-4,-3,-2,-1 /)
s2f(-1,1:4)=(/ 1,2,3,4 /)
s2f(0,1)=1
s2f(1,1:3)=(/ 2,3,4 /)
s2f(2,1:6)=(/ 5,6,7,8,9,10 /)
!---------- The sequence of f functions in Multiwfn (=wfn=wfx) is not identical to Molden, so convert here
!11  12  13  14  15  16  17  18  19  20  !Multiwfn sequence
!XXX YYY ZZZ XXY XXZ YYZ XYY XZZ YZZ XYZ
!xxx yyy zzz xyy xxy xxz xzz yzz yyz xyz !Molden sequence
s2f(3,1:10)=(/ 11,12,13,17,14,15,18,19,16,20 /)
!---------- The sequence of g functions in Multiwfn (=fch) is not identical to Molden, so convert here
! 21   22   23   24   25   26   27   28   29   30   31   32   33   34   35  !Multiwfn sequence
!ZZZZ YZZZ YYZZ YYYZ YYYY XZZZ XYZZ XYYZ XYYY XXZZ XXYZ XXYY XXXZ XXXY XXXX
!xxxx yyyy zzzz xxxy xxxz yyyx yyyz zzzx zzzy xxyy xxzz yyzz xxyz yyxz zzxy !Molden sequence
s2f(4,1:15)=(/ 35,25,21,34,33,29,24,26,22,32,30,23,31,28,27 /)
!---------- The sequence of h functions in Multiwfn (=fch=wfx) is not identical to Molden, so convert here
!Note that h angular moment is not formally supported by .molden format!!!
! 36    37    38    39    40    41    42    43    44    45    46  !Multiwfn sequence
!ZZZZZ YZZZZ YYZZZ YYYZZ YYYYZ YYYYY XZZZZ XYZZZ XYYZZ XYYYZ XYYYY
!xxxxx yyyyy zzzzz xxxxy xxxxz xyyyy xzzzz yyyyz yzzzz xxxyy xxxzz !Molden sequence
! 47    48    49    50    51    52    53    54    55    56  !Multiwfn sequence
!XXZZZ XXYZZ XXYYZ XXYYY XXXZZ XXXYZ XXXYY XXXXZ XXXXY XXXXX
!xxyyy xxzzz yyyzz yyzzz xxxyz xyyyz xyzzz xxyyz xxyzz xyyzz !Molden sequence
!s2f(5,1:21)=(/ 56,41,36,55,54,46,42,40,37,53,51,50,47,39,38,52,45,43,49,48,44 /)
!I forgot how the "Molden sequence" was previously determined by me... So, do not alter the sequence, in this case the molden generated by Multiwfn can be normally loaded
!Respective of if reordering the sequence, Multiwfn is unable to correctly load wavefunction from .molden containing h generated by ORCA (at least for 4.2.1)
forall(i=1:21) s2f(5,i)=i+35

call gensphcartab(2,conv5d6d,conv7f10f,conv9g15g,conv11h21h)

open(10,file=name,status="old")

if (infomode==0) write(*,*) "Loading various information of the wavefunction"

!!!!! Load cell information if any. May be 1/2/3-dimension
call loclabel(10,"[Cell]",ifound,maxline=50)
if (ifound==0) call loclabel(10,"[cell]",ifound,maxline=50)
if (ifound==0) call loclabel(10,"[CELL]",ifound,maxline=50)
if (ifound==1) then
    read(10,*)
    read(10,*) cellv1
    ifPBC=1
    read(10,*,iostat=ierror) cellv2
    if (ierror/=0) then
        cellv2=0
    else
        ifPBC=ifPBC+1
        read(10,*,iostat=ierror) cellv3
        if (ierror/=0) then
            cellv3=0
        else
            ifPBC=ifPBC+1
        end if
    end if
    cellv1=cellv1/b2a
    cellv2=cellv2/b2a
    cellv3=cellv3/b2a
end if

!!!!! Load atom information
call loclabel(10,"[Atoms]",ifound)
if (ifound==0) call loclabel(10,"[ATOMS]",ifound)
ilenunit=1 !Default length unit is a.u. =2 means Angstrom
read(10,"(a)") c80
if (index(c80,"Angs")/=0) ilenunit=2
ncenter=0
do while(.true.) !Count the number of atoms
	read(10,"(a)") c80
	if (c80==" ".or.index(c80,"[")/=0) then !Have passed atom field
		exit
	end if
	ncenter=ncenter+1
end do
if (allocated(a)) deallocate(a)
allocate(a(ncenter))
call loclabel(10,"[Atoms]",ifound) !Return to [Atoms]
if (ifound==0) call loclabel(10,"[ATOMS]",ifound)
read(10,"(a)") c80
!NOTICE: molden input file has a severe drawback, namely atomic charge is not explicitly recorded, this will be problematic when ECP is used
!In Multiwfn, atomic index is determined according to atomic name, while "atom number" column is read as atomic charge. Therefore, if you already konw
!current file have used ECP, then you can open the file and manually change the atomic number to atomic charge.
do iatm=1,ncenter
	read(10,*) c80,nouse,a(iatm)%charge,a(iatm)%x,a(iatm)%y,a(iatm)%z
	call lc2uc(c80(1:1)) !Convert to upper case
	call uc2lc(c80(2:2)) !Convert to lower case
	do i=0,nelesupp
		if (iachar(c80(2:2))>=48.and.iachar(c80(2:2))<=57) c80(2:2)=' ' !Dalton adds number after element name
		if (c80(1:2)==ind2name(i)) then
			a(iatm)%index=i
			a(iatm)%name=ind2name(i)
			exit
		end if
	    if (i==nelesupp) then
            if (infomode==0) then
		        write(*,"(/,3a,i5,'!')") " Warning: Found unknown element ",trim(c80(1:2))," with atom index of",iatm
		        write(*,*) "This atom now is recognized as Bq (ghost atom)"
            end if
		    a(iatm)%index=0
            a(iatm)%name=ind2name(0)
	    end if
	end do
end do
if (ilenunit==2) then !Angstrom->a.u.
	a%x=a%x/b2a
	a%y=a%y/b2a
	a%z=a%z/b2a
end if

!If user manually specified number of valence electrons of specific element, use it
call loclabel(10,"[Nval]",ifound,maxline=500)
if (ifound==1) then
    read(10,*)
    do while(.true.)
        read(10,"(a)",iostat=ierror) c80
        if (ierror/=0.or.c80==" ".or.index(c80,'[')/=0) exit
        c80=adjustl(c80)
	    call lc2uc(c80(1:1)) !Convert to upper case
	    call uc2lc(c80(2:2)) !Convert to lower case
	    do iele=0,nelesupp
            if (c80(1:2)==ind2name(iele)) exit
        end do
        if (iele<=nelesupp) then
            read(c80,*) c80tmp,ichg
            write(*,"(' Note: Nuclear charge of ',a,' has been set to',i4)") ind2name(iele),ichg
            do iatm=1,ncenter
                if (a(iatm)%index==iele) a(iatm)%charge=ichg
            end do
        end if
    end do
end if

!Detect the Molden input file is produced by which program. Special treatment is needed for ORCA, xtb and CFOUR
!If iorca/ixtb/icfour=1, that means this file was generated by orca/xtb/CFOUR
rewind(10)
iorca=0
ixtb=0
icfour=0
do while(.true.)
	read(10,"(a)") c80
	if (index(c80,"[GTO]")/=0) exit
	call struc2lc(c80)
	if (index(c80,"orca")/=0) then
		iorca=1
		exit
	else if (index(c80,"cfour")/=0) then
		icfour=1
		exit
	end if
end do
if (iorca==1.and.infomode==0) write(*,"(a)") " This file is recognized to be generated by ORCA because there is ""orca"" word in title line. &
Special treatments are applied..."
if (icfour==1.and.infomode==0) write(*,"(a)") " This file is recognized to be generated by CFour because there is ""cfour"" word in title line. &
Special treatments are applied..."
if (iorca==0.and.icfour==0) then !Test if it may be generated by xtb using the first three lines
	rewind(10)
	read(10,"(a)") c80
	if (c80=="[Molden Format]") then
		read(10,"(a)") c80
		if (c80=="[Title]") then
			read(10,"(a)") c80
			if (c80=="[Atoms] AU") then
				ixtb=1
				if (ixtb==1.and.infomode==0) write(*,*) "This file is found to be generated by xtb! Special treatment is applied..."
			end if
		end if
	end if
end if

!!!!! Load basis set, and build up GTF information
if (infomode==0) write(*,*) "Loading basis set definition..."
call loclabel(10,"[GTO]",ifound)
if (ifound==0) then
	write(*,*) "Error: Unable to locate [GTO] field! Press ENTER button to exit"
	write(*,*) "Note: [STO] is currently not supported"
	read(*,*)
	stop
end if

!First time, we count how many shells are there to allocate proper size of allocatable arrays
nshell=0
nprimshell=0
read(10,*)
do while(.true.)
	read(10,*) iatm
	do while(.true.)
		read(10,*) c80,ncon
		nshell=nshell+1
		iaddnprmsh=0
		do ish=1,ncon
			read(10,*) tmpv1,tmpv2
			if (tmpv2/=0D0) iaddnprmsh=iaddnprmsh+1 !Many GTF shells outputted by Molpro have zero concontraction coefficient, they shouldn't be read in
		end do
		nprimshell=nprimshell+iaddnprmsh
		if (index(c80,"sp")/=0.or.index(c80,"SP")/=0) then !sp shell will be separated as s and p
			nshell=nshell+1
			nprimshell=nprimshell+iaddnprmsh
		end if
		read(10,"(a)") c80
		if (c80==" ") exit
		backspace(10)
	end do
	read(10,"(a)") c80
	if (c80==" ".or.index(c80,"[")/=0) exit !Finished reading [GTO] field
	backspace(10)
end do

!Second time, read basis set information actually
allocate(shelltype(nshell),shellcon(nshell),shell2atom(nshell))
allocate(primexp(nprimshell),concoeff(nprimshell))
call loclabel(10,"[GTO]",ifound)
shellcon=0
ishell=0
iprimshell=0
read(10,*)
do while(.true.)
	read(10,*) iatm
	do while(.true.)
		read(10,*) c80,ncon
		ishell=ishell+1
		shell2atom(ishell)=iatm
		!Determine shell type of basis function, here we first assume they are all Cartesian type
		if (index(c80,"sp")/=0.or.index(c80,"SP")/=0) then
			shelltype(ishell)=-1
		else if (index(c80,"s")/=0.or.index(c80,"S")/=0) then
			shelltype(ishell)=0
		else if (index(c80,"p")/=0.or.index(c80,"P")/=0) then
			shelltype(ishell)=1
		else if (index(c80,"d")/=0.or.index(c80,"D")/=0) then
			shelltype(ishell)=2
		else if (index(c80,"f")/=0.or.index(c80,"F")/=0) then
			shelltype(ishell)=3
		else if (index(c80,"g")/=0.or.index(c80,"G")/=0) then
			shelltype(ishell)=4
		else if (index(c80,"h")/=0.or.index(c80,"H")/=0) then
			shelltype(ishell)=5
		else if (index(c80,"i")/=0.or.index(c80,"I")/=0) then
			write(*,"(a)") " Error: Multiwfn supports angular moment of basis function up to h, but this file contains basis functions with angular moment of i, &
            Multiwfn cannot deal with this case. Please use smaller basis set."
            write(*,*) "Press ENTER button to exit"
            read(*,*)
            stop
		end if
		iprimshellold=iprimshell
		do ish=1,ncon !Read exponents and contraction coefficients. For SP, here load the S one
			read(10,*) exptmp,concoefftmp
			if (concoefftmp==0D0) cycle !The shell with zero contraction coefficients will be ripped out
			iprimshell=iprimshell+1
			shellcon(ishell)=shellcon(ishell)+1
			primexp(iprimshell)=exptmp
			if (iorca==1.or.ixtb==1) then !ORCA/xtb doesn't present SP shell in Molden input file, so don't worry about -1
				!The normalization factor of spherical harmonic GTFs are weirdly multiplied into contraction coefficients,&
				!so here normalization factor is eliminated out from contraction coefficients to meet common convention
				rnorm=renormgau_ORCA(primexp(iprimshell),shelltype(ishell))
				concoefftmp=concoefftmp/rnorm
			end if
			concoeff(iprimshell)=concoefftmp
! 			write(*,"(2i4,2f18.10)") iatm,shelltype(ishell),primexp(iprimshell),concoefftmp
		end do
		nprmshadd=iprimshell-iprimshellold
		!For ORCA (or may be also other programs), d,f,g basis functions are not properly normalized, &
		!e.g. for ORCA at current stage d are normalized to 3, so renormalization (i.e. modifying contraction coefficients) is required and thus performed here
		!The LCAO coefficients always correspond to normalized basis functions (but someones normalized to -1, will be fixed at later stage)
		if (shelltype(ishell)/=-1) call renormmoldengau(nprmshadd,shelltype(ishell),&
		primexp(iprimshell-nprmshadd+1:iprimshell),concoeff(iprimshell-nprmshadd+1:iprimshell))

		if (shelltype(ishell)==-1) then !Separate SP shell as S and P shells
			shelltype(ishell)=0 !s
			call renormmoldengau(nprmshadd,shelltype(ishell),primexp(iprimshell-nprmshadd+1:iprimshell),concoeff(iprimshell-nprmshadd+1:iprimshell))
			ishell=ishell+1
			shelltype(ishell)=1 !p
			shellcon(ishell)=shellcon(ishell-1)
			shell2atom(ishell)=shell2atom(ishell-1)
			primexp(iprimshell+1:iprimshell+nprmshadd)=primexp(iprimshellold+1:iprimshell)
			do itmp=1,ncon !Backspace and load P contract coefficient
				backspace(10)
			end do
			do itmp=1,ncon
				read(10,*) exptmp,rnouse,concoefftmp
				if (concoefftmp==0D0) cycle
				iprimshell=iprimshell+1
				concoeff(iprimshell)=concoefftmp
			end do
			call renormmoldengau(nprmshadd,shelltype(ishell),primexp(iprimshell-nprmshadd+1:iprimshell),concoeff(iprimshell-nprmshadd+1:iprimshell))
		end if
		read(10,"(a)") c80
		if (c80==" ") exit
		backspace(10)
	end do
	read(10,"(a)") c80
	if (c80==" ".or.index(c80,"[")/=0) exit !Finished reading [GTO] field
	backspace(10)
end do

!Determine if the basis functions are Cartesian or spherical harmonic type. Admixture Cartesian and spherical type are permitted
isphergau=0 !Default is Cartesian type
i5D=0
i7F=0
i10Flabel=0
i9G=0
i11H=0

if (iorca==1) then !ORCA only uses spherical harmonic type and thus need not to be tested
    i5D=1;i7F=1;i9G=1;i11H=1
else
    imaxL=maxval(shelltype)
    if (infomode==0) write(*,"(' The highest angular moment basis functions is ',a)") shtype2name(imaxL)
    if (imaxL>=2) then !Containing d or higher basis functions
	    rewind(10)
	    do while(.true.)
		    read(10,"(a)") c80
		    if (index(c80,'[5D')/=0.or.index(c80,'[5d')/=0) i5D=1
		    if (index(c80,'[7F')/=0.or.index(c80,'[7f')/=0) i7F=1
		    if (index(c80,'10F')/=0) i10Flabel=1
		    if (index(c80,'9G')/=0.or.index(c80,'9g')/=0) i9G=1
		    if (index(c80,'11H')/=0.or.index(c80,'11h')/=0) i11H=1
		    if (index(c80,'[MO]')/=0) exit
	    end do
	    if (i5D==1) then !By default, using 5D also implies 7F is used, unless 10F is explicitly specified
		    i7F=1
		    if (i10Flabel==1) i7F=0
	    end if
        if (imaxL==4.and.i7F==1.and.i9G==0) then
            write(*,"(a)") " Note: f functions are harmonic spherical but [9G] label was not found. All g functions are assumed to be harmonic spherical type"
            i9G=1
        end if
        if (imaxL==5.and.i9G==1.and.i11H==0) then
            write(*,"(a)") " Note: g functions are harmonic spherical but [11H] label was not found. All h functions are assumed to be harmonic spherical type"
            i11H=1
        end if
    end if
end if

if (i5D==1.or.i7F==1.or.i9G==1.or.i11H==1) isphergau=1
if (i5D==1) where(shelltype==2) shelltype=-2
if (i7F==1) where(shelltype==3) shelltype=-3
if (i9G==1) where(shelltype==4) shelltype=-4
if (i11H==1) where(shelltype==5) shelltype=-5
if (infomode==0) then
	if (isphergau==0) then
		write(*,*) "All basis functions are Cartesian type"
	else if (isphergau==1) then
		if (i5D==1.and.any(abs(shelltype)==2)) write(*,*) "All D basis functions are spherical harmonic type"
		if (i7F==1.and.any(abs(shelltype)==3)) write(*,*) "All F basis functions are spherical harmonic type"
		if (i9G==1.and.any(abs(shelltype)==4)) write(*,*) "All G basis functions are spherical harmonic type"
		if (i11H==1.and.any(abs(shelltype)==5)) write(*,*) "All H basis functions are spherical harmonic type"
	end if
end if
nbasis=0
do ishell=1,nshell
	nbasis=nbasis+shtype2nbas(shelltype(ishell))
end do

!!!!! Load orbital information. The sequence: Alpha(high occ / low ene) -> Alpha(low occ / high ene) -> Beta(high occ / low ene) -> Beta(low occ / high ene)
!Close shell orbitals are formally marked as "Alpha" spin. For singly occupied orbitals of ROHF, the spin marker are also Alpha
if (infomode==0) write(*,*) "Loading orbitals..."
nmo=nbasis
! Here I don't use call loclabel(10,"Beta",ibeta) to check if there are Beta orbitals, because for very large file, this will be quite expensive
! I assume that when the first orbital has occupation number <1.05, then the wavefunction must be unrestricted
ibeta=0
call loclabel(10,"[MO]")
do while(.true.)
	read(10,"(a)") c80
	if (index(c80,"OCCUP=")/=0.or.index(c80,"Occup=")/=0) then
		read(c80,*) c80tmp,occtmp
		if (occtmp<1.05D0) ibeta=1
		exit
	end if
end do
!Allocate size for arrays
if (ibeta==0) then
	nmo=nbasis
	allocate(amocoeff(nmo,nbasis),MOocc(nmo),MOene(nmo),MOtype(nmo),MOsym(nmo))
	amocoeff=0D0
else if (ibeta==1) then
	nmo=2*nbasis
	allocate(amocoeff(nbasis,nbasis),bmocoeff(nbasis,nbasis),MOocc(nmo),MOene(nmo),MOtype(nmo),MOsym(nmo))
	amocoeff=0D0
	bmocoeff=0D0
end if
MOsym=" "
MOocc=0D0
MOene=0D0
!Start to load orbitals
call loclabel(10,"[MO]")
read(10,*)
iMOa=0
iMOb=0
iloadorb=0
do while(.true.)
	iloadorb=iloadorb+1
	read(10,"(a)") c80 !Test if it is "Sym=", some programs do not output this field
	isym=index(c80,"Sym")
	if (isym==0) isym=index(c80,"SYM")
	if (isym/=0) then
		ieq=index(c80,'=')
		read(c80(ieq+1:),*) symtmp
		!Remove digitals before the IRREP, e.g. 23B1 should be changed to B1
		do jtmp=1,len(symtmp)
			if (ichar(symtmp(jtmp:jtmp))<48.or.ichar(symtmp(jtmp:jtmp))>57) exit !Find the first position of non-digital
		end do
		symtmp=symtmp(jtmp:len(symtmp))
	else
		symtmp="?"
		backspace(10)
	end if

	read(10,"(a)") c80 !Read orbital energy. Since there may be no spacing between = and energy (Bagel program), position of = should be tested
	!write(*,"(a)") trim(c80)
	ieq=index(c80,'=')
	read(c80(ieq+1:),*) enetmp
 	!write(*,*) iloadorb,enetmp,nbasis,nmo  !<<------ If encountering problem when loading MOs, using this to locate the problematic MO
    !When loading is failed, it is suggested to search *** in the molden file

	read(10,"(a)") c80 !Read orbital spin
	ispintmp=1 !Alpha
	if (index(c80,"Beta")/=0) ispintmp=2 !Beta
	read(10,*) c80,occtmp !Read orbital occupation number
	if (ispintmp==1) then
		iMOa=iMOa+1
		MOocc(iMOa)=occtmp
		MOene(iMOa)=enetmp
        call corrsymlab(MOsym(iMOa),symtmp) !Purify symmetry label to meet standard
		do while(.true.) !This loading way is compatible with Dalton and .molden by all other programs
			read(10,*,iostat=ierror) itmp,tmpval
			if (ierror/=0) then
				backspace(10)
				exit
			end if
			amocoeff(iMOa,itmp)=tmpval
		end do
	else
		iMOb=iMOb+1
		MOocc(nbasis+iMOb)=occtmp
		MOene(nbasis+iMOb)=enetmp
        call corrsymlab(MOsym(nbasis+iMOb),symtmp) !Purify symmetry label to meet standard
		do while(.true.)
			read(10,*,iostat=ierror) itmp,tmpval
			if (ierror/=0) then
				backspace(10)
				exit
			end if
			bmocoeff(iMOb,itmp)=tmpval
		end do
	end if

	read(10,"(a)",iostat=ierror) c80 !Test if the ending of [MO] field is reached
	if (ierror/=0.or.c80==" ".or.index(c80,'[')/=0) exit
	backspace(10)
end do

!Fix orbital coefficients for ORCA. ORCA is rather rather frantic:
!the F(+3,-3) and G(+3,-3,+4,-4) and H(+3,-3,+4,-4) in ORCA are normalized to -1 rather than 1
!therefore the sign of their coefficients in all orbitals must be inverted! Hey ORCA, why did you use so strange convention????? Totally non-understandable!
if (iorca==1) then
	ibasis=0
	do ishell=1,nshell
		if (shelltype(ishell)==-3) then !f
			amocoeff(:,ibasis+6:ibasis+7)=-amocoeff(:,ibasis+6:ibasis+7)
			if (ibeta==1) bmocoeff(:,ibasis+6:ibasis+7)=-bmocoeff(:,ibasis+6:ibasis+7)
		else if (shelltype(ishell)==-4) then !g
			amocoeff(:,ibasis+6:ibasis+9)=-amocoeff(:,ibasis+6:ibasis+9)
			if (ibeta==1) bmocoeff(:,ibasis+6:ibasis+9)=-bmocoeff(:,ibasis+6:ibasis+9)
		else if (shelltype(ishell)==-5) then !h
            amocoeff(:,ibasis+6:ibasis+9)=-amocoeff(:,ibasis+6:ibasis+9)
		end if
		ibasis=ibasis+shtype2nbas(shelltype(ishell))
	end do
end if
!Fix orbital coefficients for CFour according to Molden2aim. CFour only use Cartesian type basis function
!Notice that at current stage the GTO recording sequence has not been reordered, which is still identical to Molden sequence
!Also notice that even we do this, the result is still incorrect for e.g. benzene. But if we don't do this, we can't even obtain correct result for test case of Molden2aim
if (icfour==1) then
	ibasis=0
	do ishell=1,nshell
		if (shelltype(ishell)==2) then
			!xx, yy, zz, xy, xz, yz
			amocoeff(:,ibasis+1:ibasis+3)=amocoeff(:,ibasis+1:ibasis+3)*sqrt(3D0) !d(xx,yy,zz)*sqrt(3)
			if (ibeta==1) bmocoeff(:,ibasis+1:ibasis+3)=bmocoeff(:,ibasis+1:ibasis+3)*sqrt(3D0)
		else if (shelltype(ishell)==3) then
			!xxx yyy zzz xyy xxy xxz xzz yzz yyz xyz !Molden sequence
			amocoeff(:,ibasis+1:ibasis+3)=amocoeff(:,ibasis+1:ibasis+3)*sqrt(15D0) !f(xxx,yyy,zzz)*sqrt(15)
			amocoeff(:,ibasis+4:ibasis+9)=amocoeff(:,ibasis+4:ibasis+9)*sqrt(3D0) !f(xyy,xzz,yxx,yzz,zxx,zyy)*sqrt(3)
			if (ibeta==1) then
				bmocoeff(:,ibasis+1:ibasis+3)=bmocoeff(:,ibasis+1:ibasis+3)*sqrt(15D0)
				bmocoeff(:,ibasis+4:ibasis+9)=bmocoeff(:,ibasis+4:ibasis+9)*sqrt(3D0)
			end if
		else if (shelltype(ishell)==4) then
			!xxxx yyyy zzzz xxxy xxxz yyyx yyyz zzzx zzzy xxyy xxzz yyzz xxyz yyxz zzxy !Molden sequence
			amocoeff(:,ibasis+1:ibasis+3)=amocoeff(:,ibasis+1:ibasis+3)*sqrt(105D0) !g(x4,y4,z4)*sqrt(105)
			amocoeff(:,ibasis+4:ibasis+9)=amocoeff(:,ibasis+4:ibasis+9)*sqrt(15D0) !g(x3y,x3z,y3x,y3z,z3x,z3y)*sqrt(15)
			amocoeff(:,ibasis+10:ibasis+12)=amocoeff(:,ibasis+10:ibasis+12)*3D0 !g(x2y2,x2z2,y2z2)*3.0
			amocoeff(:,ibasis+13:ibasis+15)=amocoeff(:,ibasis+13:ibasis+15)*sqrt(3D0) !g(x2yz,y2xz,z2xy)*sqrt(3)
			if (ibeta==1) then
				bmocoeff(:,ibasis+1:ibasis+3)=bmocoeff(:,ibasis+1:ibasis+3)*sqrt(105D0)
				bmocoeff(:,ibasis+4:ibasis+9)=bmocoeff(:,ibasis+4:ibasis+9)*sqrt(15D0)
				bmocoeff(:,ibasis+10:ibasis+12)=bmocoeff(:,ibasis+10:ibasis+12)*3D0
				bmocoeff(:,ibasis+13:ibasis+15)=bmocoeff(:,ibasis+13:ibasis+15)*sqrt(3D0)
			end if
		end if
		ibasis=ibasis+shtype2nbas(shelltype(ishell))
	end do
end if
!xtb ignore core orbitals (including subvalence ones), therefore the nuclear charge of atoms must be substracted by number of core electrons
if (ixtb==1) then
	do i=1,ncenter
		if (a(i)%index>2.and.a(i)%index<=10) a(i)%charge=a(i)%charge-2
		if (a(i)%index>=11.and.a(i)%index<=18) a(i)%charge=a(i)%charge-10 !Na~Ar
		if (a(i)%index>=19.and.a(i)%index<=29) a(i)%charge=a(i)%charge-18 !K~Cu
		if (a(i)%index>=30.and.a(i)%index<=36) a(i)%charge=a(i)%charge-28 !Zn~Kr
		if (a(i)%index>=37.and.a(i)%index<=47) a(i)%charge=a(i)%charge-36 !Rb~Ag
		if (a(i)%index>=48.and.a(i)%index<=54) a(i)%charge=a(i)%charge-46 !Cd~Xe
		if (a(i)%index==55.and.a(i)%index==56) a(i)%charge=a(i)%charge-54 !Cs~Ba
		if (a(i)%index>=57.and.a(i)%index<=71) a(i)%charge=3 !La~Lu. I have confirmed this by practical calculation
		if (a(i)%index>=72.and.a(i)%index<=79) a(i)%charge=a(i)%charge-68 !Hf~Au
		if (a(i)%index>=80.and.a(i)%index<=86) a(i)%charge=a(i)%charge-78 !Hg~Rn
        !GFN-xTB only supports up to 86
	end do
end if

!Determine wavefunction type
if (ibeta==0) then
	MOtype=0 !Close shell orbital
	wfntype=0 !RHF
	if (any(MOocc/=nint(MOocc))) then
		wfntype=3 !R-post-HF
	else if (any(MOocc==1D0)) then
		wfntype=2 !ROHF
		do imo=1,nmo
			if (MOocc(imo)==1D0) MOtype(imo)=1
		end do
	end if
	if (infomode==0) write(*,"( ' The actual number of orbitals read:',i10)") iMOa
else if (ibeta==1) then
	wfntype=1 !UHF
	if (any(MOocc/=nint(MOocc))) wfntype=4 !U-post-HF
	MOtype(1:nbasis)=1
	MOtype(nbasis+1:nmo)=2
	if (infomode==0) write(*,"( ' The actual number of Alpha/Beta orbitals read:',i10,'  /',i10)") iMOa,iMOb
end if
call updatenelec !Cound the number of electrons

close(10)

!!!!!! All reading have finished, now generate basis information
!Below codes are adapted from readfch

!Backup spherical Gaussian basis information with 5D suffix (of course, may be 7f, 9g... in fact), &
!convert them to Cartesian type temporarily, at final stage recover them back
if (isphergau==1) then
	allocate(shelltype5D(nshell))
	shelltype5D=shelltype
	where (shelltype<=-2) shelltype=-shelltype !Convert to Cartesian type
	nbasis5D=nbasis
	nbasis=0
	do i=1,nshell
		nbasis=nbasis+shtype2nbas(shelltype(i))
	end do
end if
allocate(shtypeCar(nbasis)) !Store shell information of Cartesian basis into global array, which may be used later
shtypeCar=shelltype
nbasisCar=nbasis

!Allocate space for arrays
nprims=0
do i=1,nshell
	nprims=nprims+shtype2nbas(shelltype(i))*shellcon(i)
end do
allocate(b(nprims),CO(nmo,nprims),basshell(nbasis),bascen(nbasis),bastype(nbasis),primstart(nbasis),&
primend(nbasis),primconnorm(nprims),basstart(ncenter),basend(ncenter))

!Fill Cobasa and CObasb
if (isphergau==0) then
	allocate(CObasa(nbasis,nbasis))
	CObasa=transpose(amocoeff)
	if (wfntype==1.or.wfntype==4) then
		allocate(CObasb(nbasis,nbasis))
		CObasb=transpose(bmocoeff)
	end if
else if (isphergau==1) then !Since we have artifically converted spherical shells to Cartesian shells, here the orbital coefficients are also correspondingly converted
	allocate(CObasa(nbasis,nbasis),CObasa5D(nbasis5D,nbasis5D))
	CObasa5D=transpose(amocoeff)
	CObasa=0D0
	if (wfntype==1.or.wfntype==4) then
		allocate(CObasb(nbasis,nbasis),CObasb5D(nbasis5D,nbasis5D))
		CObasb5D=transpose(bmocoeff)
		CObasb=0D0
	end if
	!Map 5D coefficient to 6D coefficient. Since the number of spherical basis functions is more than Cartesian ones,
	!therefore Cobasa (6D) will have some orbitals with vacant coefficients, only orbitals (1~nbasis5D) are filled
	ipos5D=1
	ipos6D=1
	do ish=1,nshell
		ishtyp5D=shelltype5D(ish)
		ishtyp6D=shelltype(ish)
		numshorb5D=shtype2nbas(ishtyp5D)
		numshorb6D=shtype2nbas(ishtyp6D)
		if (ishtyp5D>=-1) then !S or P or SP or other Cartesian shells, directly copy
			CObasa(ipos6D:ipos6D+numshorb6D-1,1:nbasis5D)=CObasa5D(ipos5D:ipos5D+numshorb5D-1,:)
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+numshorb6D-1,1:nbasis5D)=CObasb5D(ipos5D:ipos5D+numshorb5D-1,:)
		else if (ishtyp5D==-2) then
			!5D->6D
			CObasa(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,CObasa5D(ipos5D:ipos5D+4,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,CObasb5D(ipos5D:ipos5D+4,:))
		else if (ishtyp5D==-3) then
			!7F->10F
			CObasa(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,CObasa5D(ipos5D:ipos5D+6,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,CObasb5D(ipos5D:ipos5D+6,:))
		else if (ishtyp5D==-4) then
			!9G->15G
			CObasa(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,CObasa5D(ipos5D:ipos5D+8,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,CObasb5D(ipos5D:ipos5D+8,:))
		else if (ishtyp5D==-5) then
			!11H->21H
			CObasa(ipos6D:ipos6D+20,1:nbasis5D)=matmul(conv11h21h,CObasa5D(ipos5D:ipos5D+10,:))
			if (wfntype==1.or.wfntype==4) CObasb(ipos6D:ipos6D+20,1:nbasis5D)=matmul(conv11h21h,CObasb5D(ipos5D:ipos5D+10,:))
		end if
		ipos5D=ipos5D+numshorb5D
		ipos6D=ipos6D+numshorb6D
	end do
end if

if (infomode==0) write(*,*) "Converting basis function information to GTF information..."
!Distribute exponent, functype to every GTF and generate CO(:,:) from amocoeff/bmocoeff
!Fill: b,basshell,bascen,bastype,co,primstart,primend,primconnorm
k=1 !current position of GTF
iexp=1
ibasis=1 !current position of basis
!Note: Below commented with !!! means the line associated to setting basis information
do i=1,nshell !cycle each basis shell
	b(k:k+shellcon(i)*shtype2nbas(shelltype(i))-1)%center=shell2atom(i)
	basshell(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=i !!! set basis attributed to which shell
	bascen(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=shell2atom(i) !!! set basis attributed to which center
	do j=1,shtype2nbas(shelltype(i)) !cycle each basis function in each basis shell
		b(k:k+shellcon(i)-1)%type=s2f(shelltype(i),j)
		bastype(ibasis)=s2f(shelltype(i),j) !!! set basis type
		primstart(ibasis)=k !!! From where the GTFs attributed to ibasis'th basis
		primend(ibasis)=k+shellcon(i)-1 !!! To where the GTFs attributed to ibasis'th basis
		do l=1,shellcon(i) !cycle each GTF in each basis function
			b(k)%exp=primexp(iexp+l-1)
			tnormgau=normgau(b(k)%type,b(k)%exp)  !!!Normalization coefficient of Cartesian GTFs
			temp=concoeff(iexp+l-1)  !!!Contraction coefficient of GTFs
			primconnorm(k)=temp*tnormgau !Combines contraction and normalization coefficient
			do imo=1,nmo
				if (wfntype==0.or.wfntype==2.or.wfntype==3) then
					CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
! 					if (imo==4) write(*,"(4f18.10)") CO(imo,k),CObasa(ibasis,imo),temp,tnormgau
				else if (wfntype==1.or.wfntype==4) then
					if (isphergau==1) then
						if (imo<=nbasis5D) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
						if (imo>nbasis5D) CO(imo,k)=CObasb(ibasis,imo-nbasis5D)*temp*tnormgau
					else
						if (imo<=nbasis) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
						if (imo>nbasis) CO(imo,k)=CObasb(ibasis,imo-nbasis)*temp*tnormgau
					end if
				end if
			end do
			k=k+1
		end do
		ibasis=ibasis+1
	end do
	iexp=iexp+shellcon(i)
end do

!Check normalizaiton of basis functions
! do i=1,size(sbas,1)
! 	write(*,"(i10,f12.6)") i,sbas(i,i)
! end do

if (isphergau==1) then
	if (iloadasCart==1) then !For special purpose, keep Cartesian basis functions, e.g. convert spherical .fch/.molden to .47 file
		!Currently nbasis and dimension of all matrix (except for CO) correspond to full Cartesian case, but nmo &
		!and related arrays as well as CO still correspond to spherical harmonic case and thus need to be "expanded", the MO energies are artifically set to 100
		allocate(MOocc5D(nmo),MOene5D(nmo),MOtype5D(nmo),MOsym5D(nmo),CO5D(nmo,nprims))
		MOocc5D=MOocc
		MOene5D=MOene
		MOtype5D=MOtype
		MOsym5D=MOsym
		CO5D=CO
		deallocate(MOocc,MOene,MOtype,MOsym,CO)
		if (wfntype==0.or.wfntype==2.or.wfntype==3) nmo=nbasis !R, RO
		if (wfntype==1.or.wfntype==4) nmo=2*nbasis !U
		allocate(MOocc(nmo),MOene(nmo),MOtype(nmo),MOsym(nmo),CO(nmo,nprims))
		MOocc=0
		MOene=100
		MOsym=" "
		CO=0
		if (wfntype==0.or.wfntype==2.or.wfntype==3) then !R, RO
			MOtype=0
			MOocc(1:nbasis5D)=MOocc5D
			MOene(1:nbasis5D)=MOene5D
			MOtype(1:nbasis5D)=MOtype5D
			MOsym(1:nbasis5D)=MOsym5D
			CO(1:nbasis5D,:)=CO5D
		else !U
			MOtype(:nbasis)=1
			MOtype(nbasis+1:)=2
			MOocc(:nbasis5D)=MOocc5D(:nbasis5D)
			MOocc(nbasis+1:nbasis+nbasis5D)=MOocc5D(nbasis5D+1:)
			MOene(:nbasis5D)=MOene5D(:nbasis5D)
			MOene(nbasis+1:nbasis+nbasis5D)=MOene5D(nbasis5D+1:)
			MOtype(:nbasis5D)=MOtype5D(:nbasis5D)
			MOtype(nbasis+1:nbasis+nbasis5D)=MOtype5D(nbasis5D+1:)
			MOsym(:nbasis5D)=MOsym5D(:nbasis5D)
			MOsym(nbasis+1:nbasis+nbasis5D)=MOsym5D(nbasis5D+1:)
			CO(:nbasis5D,:)=CO5D(:nbasis5D,:)
			CO(nbasis+1:nbasis+nbasis5D,:)=CO5D(nbasis5D+1:,:)
		end if
		isphergau=0

	else !Commonly case, transform to spherical harmonic functions
		if (infomode==0) write(*,*) "Back converting basis function information from Cartesian to spherical type..."
		!Recover spherical Gaussian basis function information
		nbasis=nbasis5D
		shelltype=shelltype5D
		ibasis=1
		do i=1,nshell
			basshell(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=i
			bascen(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=shell2atom(i)
			do j=1,shtype2nbas(shelltype(i))
				bastype(ibasis)=s2f(shelltype(i),j)
				ibasis=ibasis+1
			end do
		end do
		deallocate(CObasa)
		allocate(CObasa(nbasis,nbasis))
		CObasa=CObasa5D
		if (wfntype==1.or.wfntype==4) then
			deallocate(CObasb)
			allocate(CObasb(nbasis,nbasis))
			CObasb=CObasb5D
		end if
	end if
end if

!Move local shell arrays to the global ones, they will be used in other functions
allocate(shtype(nshell),shcen(nshell),shcon(nshell),primshexp(nprimshell),primshcoeff(nprimshell))
shtype=shelltype
shcen=shell2atom
shcon=shellcon
primshexp=primexp
primshcoeff=concoeff

!Generate basstart and basend
nowcen=0
indcen=0
do ibasis=1,nbasis
	if (bascen(ibasis)/=nowcen) then
		nowcen=bascen(ibasis)
		indcen=indcen+1
		basstart(indcen)=ibasis
		if (indcen/=1) basend(indcen-1)=ibasis-1
	end if
end do
basend(ncenter)=nbasis

!Generate one-particle density matrix for basis functions
if (igenP==1) then
	if (infomode==0) write(*,*) "Generating density matrix..."
	call genP
end if
if (ifPBC==0) then !It is meaningless to generate Sbas in usual way for PBC systems
    if (infomode==0) write(*,*) "Generating overlap matrix..."
    call genSbas_curr
end if

!Check wavefunction sanity for non-PBC case
if (iorca==0.and.ifPBC==0) then !For ORCA with angular moment >f, warning has already been shown before
	devtmp=abs(sum(Sbas*Ptot)-nint(nelec))
	if (devtmp>0.01D0) then
		write(*,"( ' Deviation of Tr(S*P) to the total number of electrons:',f12.6)") devtmp
		write(*,"(/,a)") " Warning: The wavefunction loaded is problematic! That means this Molden input file cannot be well supported by Multiwfn. &
		I strongly suggest you use Molden2AIM program to standardize this file before loading into Multiwfn. Please check Section 5.1 of the manual for detail"
		!write(*,"(a)") " If you really want to proceed, press ENTER button, but notice that the result will not be correct"
		!read(*,*)
	end if
end if

!Output summary of present wavefunction
if (infomode==0) then
	write(*,*)
	write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Net charge:',f12.5,'      Expected multiplicity:',i5)") sum(a(:)%charge)-nelec,nint(naelec-nbelec)+1
	write(*,"(' Atoms:',i7,',  Basis functions:',i7,',  GTFs:',i7)") ncenter,nbasis,nprims
	if (wfntype==0) then
		write(*,"(' This is a restricted single-determinant wavefunction')")
		write(*,"(' Orbitals from 1 to',i6,' are occupied')") nint(nelec/2)
	else if (wfntype==1) then
		write(*,"(' This is an unrestricted single-determinant wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are occupied')") 1,nbasis,1,nint(naelec)
		write(*,"(' Orbitals from ',i6,' to',i6,' are beta,  from',i6,' to',i6,' are occupied')") nbasis+1,nmo,nbasis+1,nbasis+nint(nbelec)
	else if (wfntype==2) then
		write(*,"(' This is a restricted open-shell wavefunction')")
		write(*,"(' Orbitals from',i6,' to',i6,' are doubly occupied')") 1,nint(nbelec)
		write(*,"(' Orbitals from',i6,' to',i6,' are singly occupied')") nint(nbelec)+1,nint(naelec)
	else if (wfntype==3) then
		write(*,"(' This is a restricted multiconfiguration wavefunction')")
	else if (wfntype==4) then
		write(*,"(' This is an unrestricted multiconfiguration wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are beta')") 1,nbasis,nbasis+1,nmo
	end if
end if

call getHOMOidx !Find out index of HOMO, will be used in some cases

tmpnet=sum(a%charge)-nelec
if (tmpnet>18.and.any(a%index>18)) then
    write(*,"(/,a)") " !! Warning! Warning! Warning! Warning! Warning! Warning! Warning! Warning !!"
    write(*,"(a,i5,a)") " The net charge of this system is quite large (",nint(tmpnet),")! Probably ECP is employed while you &
    forgot to modify the atomic indices in [atoms] field of the .molden file to actual nuclear charges, in this case some &
    analysis results will be problematic! Please check ""Molden"" part of Section 2.5 of Multiwfn manual to understand why and how to modify the file"
    write(*,*) "Press ENTER button to continue"
    read(*,*)
end if

end subroutine

!--- Purify symmetry label to meet Multiwfn standard, used by readmolden. e.g. 61a1g --> A1g
subroutine corrsymlab(symnew,symorg)
use util
implicit real*8 (a-h,o-z)
character(len=*) symorg,symnew
symorg=adjustl(symorg)
do i=1,len_trim(symorg)
    itmp=ichar(symorg(i:i))
    if ((itmp>=65.and.itmp<=90).or.(itmp>=97.and.itmp<=122)) exit
end do
symnew=" "
symnew=trim(symorg(i:))
itmp=ichar(symnew(1:1))
if (itmp>=97.and.itmp<=122) call lc2uc(symnew(1:1)) !To upper case
do i=2,len_trim(symnew)
    itmp=ichar(symnew(i:i))
    if (itmp>=65.and.itmp<=90) call uc2lc(symnew(i:i)) !To lower case
end do
end subroutine

!---------- Read GAMESS-US output file to get GTF and basis information, the suffix must be "gms"
!GAMESS-US always print LCAO cofficients as Cartesian basis functions, while the number of MOs correspond to spherical harmonic functions (if used)
!infomode=0 means output info, =1 silent
subroutine readgms(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) name
character c80*80,chartmp
integer :: s2f(0:5,21)=0 !Give shell type & orbital index to get functype
real*8,allocatable :: amocoeff(:,:),bmocoeff(:,:)
integer,allocatable :: zcore(:) !The number of core electrons replaced with ECP
real*8,external :: normgau

ifiletype=10
imodwfn=0
s2f(0,1)=1
s2f(1,1:3)=(/ 2,3,4 /)
s2f(2,1:6)=(/ 5,6,7,8,9,10 /)
!---------- The sequence of f functions in Multiwfn (=wfn=wfx) is not identical to GAMESS, so convert here
!11  12  13  14  15  16  17  18  19  20  !Multiwfn sequence
!XXX YYY ZZZ XXY XXZ YYZ XYY XZZ YZZ XYZ
!xxx yyy zzz xxy xxz xyy yyz zzx zzy xyz !GAMESS sequence
s2f(3,1:10)=(/ 11,12,13,14,15,17,16,18,19,20 /)
!---------- The sequence of g functions in Multiwfn (=fch) is not identical to GAMESS(=molden), so convert here
! 21   22   23   24   25   26   27   28   29   30   31   32   33   34   35  !Multiwfn sequence
!ZZZZ YZZZ YYZZ YYYZ YYYY XZZZ XYZZ XYYZ XYYY XXZZ XXYZ XXYY XXXZ XXXY XXXX
!xxxx yyyy zzzz xxxy xxxz yyyx yyyz zzzx zzzy xxyy xxzz yyzz xxyz yyxz zzxy !GAMESS sequence
s2f(4,1:15)=(/ 35,25,21,34,33,29,24,26,22,32,30,23,31,28,27 /)
!---------- The sequence of h functions in Multiwfn (=fch=wfx) is not identical to GAMESS, so convert here
! 36    37    38    39    40    41    42    43    44    45    46  !Multiwfn sequence
!ZZZZZ YZZZZ YYZZZ YYYZZ YYYYZ YYYYY XZZZZ XYZZZ XYYZZ XYYYZ XYYYY
!xxxxx yyyyy zzzzz xxxxy xxxxz xyyyy yyyyz xzzzz yzzzz xxxyy xxxzz !GAMESS sequence
! 47    48    49    50    51    52    53    54    55    56  !Multiwfn sequence
!XXZZZ XXYZZ XXYYZ XXYYY XXXZZ XXXYZ XXXYY XXXXZ XXXXY XXXXX
!xxyyy yyyzz xxzzz yyzzz xxxyz xyyyz xyzzz xxyyz xxyzz xyyzz !GAMESS sequence
s2f(5,1:21)=(/ 56,41,36,55,54,46,40,42,37,53,51, 50,39,47,38,52,45,43,49,48,44 /)

open(10,file=name,status="old")
call loclabel(10,"Firefly Project",ifirefly,maxline=100)
if (ifirefly==1) write(*,*) "Note: This file will be recognized as Firefly output"
if (infomode==0) write(*,*) "Loading various information of the wavefunction"

!!!!! Sanity check
call loclabel(10,"RUNTYP=OPTIMIZE",iopt,maxline=10000)
if (iopt==1) then
	!Although GAMESS-US output final geometry and corresponding wavefunction (labelled by "MOLECULAR ORBITALS"),
	!the number of orbitals is much smaller than expected, therefore unable to provide enough information
	write(*,"(a)") " Warning: This is an optimization task, only wavefunction corresponding to initial geometry will be loaded"
	write(*,*) "Press ENTER button to continue"
	read(*,*)
end if
!If point group is not C1, only basis set definition of symmetry unique atoms is printed
call loclabel(10,"THE POINT GROUP OF THE MOLECULE IS C1",iC1,maxline=1000)
if (iC1==0) then
    write(*,"(a)") " Error: The point group is not C1, Multiwfn does not support this case"
	write(*,*) "Press ENTER button to exit"
	read(*,*)
    stop
end if

!!!!! Load atom information
call loclabel(10,"TOTAL NUMBER OF ATOMS",ifound)
if (ifirefly==0) read(10,"(47x,i5)") ncenter
if (ifirefly==1) read(10,"(38x,i5)") ncenter
allocate(a(ncenter))
call loclabel(10,"ATOM      ATOMIC",ifound)
read(10,*)
read(10,*)
do iatm=1,ncenter
	read(10,*) c80,a(iatm)%index,a(iatm)%x,a(iatm)%y,a(iatm)%z
end do
a%name=ind2name(a%index)
a%charge=a%index
rewind(10)

!!!!! Load basis set, and build up GTF information
!First time, we count how many shells are there to allocate proper size of allocatable arrays
if (ifirefly==0) call loclabel(10,"SHELL TYPE  PRIMITIVE",ifound)
if (ifirefly==1) call loclabel(10,"SHELL TYPE PRIM",ifound)
if (ifound==0) then
	write(*,"(' Error: Unable to find basis set definition section!')")
	write(*,*) "Press ENTER button to exit"
	read(*,*)
	stop
else
	if (infomode==0) write(*,*) "Loading basis set definition..."
end if
read(10,*)
read(10,*)
iaddshell=0
nshell=0
nprimshell=0
do iatm=1,ncenter
	read(10,*) !Atom name
	read(10,*)
	do while(.true.)
		read(10,"(a)") c80
		if (c80==" ") then !Finished loading last shell
			nshell=nshell+1
			if (iaddshell==1) nshell=nshell+1 !Last shell is L
			iaddshell=0
			read(10,"(a)") c80;backspace(10)
			if (iachar(c80(2:2))>=65) exit !The second column of next line is a letter, indicating that reading present atom has finished
			if (c80==" ") exit !The next line is blank (may occur in the case of Firefly), indicating the whole field of basis set definition has finished
		else
			nprimshell=nprimshell+1
			if (index(c80,"L")/=0) then
				nprimshell=nprimshell+1 !sp shell will be separated as s and p
				iaddshell=1
			end if
		end if
	end do
end do

!Second time, read basis set information actually
allocate(shtype(nshell),shcon(nshell),shcen(nshell))
allocate(primshexp(nprimshell),primshcoeff(nprimshell))
if (ifirefly==0) call loclabel(10,"SHELL TYPE  PRIMITIVE",ifound)
if (ifirefly==1) call loclabel(10,"SHELL TYPE PRIM",ifound)
read(10,*)
read(10,*)
shcon=0
ishell=1
iprimshell=0
do iatm=1,ncenter
	read(10,*) !Atom name
	read(10,*)
	do while(.true.)
		read(10,"(a)") c80
		if (c80==" ") then !Finished loading last basis shell
			if (shtype(ishell)==-1) then !Separate SP shell as S and P shells
				shtype(ishell)=0 !s
				ishell=ishell+1
				shtype(ishell)=1 !p
				shcon(ishell)=shcon(ishell-1)
				shcen(ishell)=shcen(ishell-1)
				do itmp=1,shcon(ishell)+1 !Backspace and load P contraction coefficient
					backspace(10)
				end do
				do itmp=1,shcon(ishell)
					iprimshell=iprimshell+1
					if (ifirefly==0) then
						read(10,*) inouse,chartmp,inouse,primshexp(iprimshell),rnouse,primshcoeff(iprimshell)
					else
						read(10,"(a)") c80
						read(c80,*) inouse,chartmp,inouse,primshexp(iprimshell)
						read(c80(69:78),*) primshcoeff(iprimshell)
					end if
				end do
				read(10,*)
			end if
			ishell=ishell+1
			read(10,"(a)") c80;backspace(10)
			if (iachar(c80(2:2))>=65) exit !The second column of next line is a letter, indicating that reading present atom has finished
			if (c80==" ") exit !The next line is blank (may occur in the case of Firefly), indicating the whole field of basis set definition has finished
		else !Loading a new basis shell
			iprimshell=iprimshell+1
			shcon(ishell)=shcon(ishell)+1
			if (ifirefly==0) then
				read(c80,*) inouse,chartmp,inouse,primshexp(iprimshell),primshcoeff(iprimshell)
			else
				read(c80,*) inouse,chartmp,inouse,primshexp(iprimshell)
				read(c80(43:52),*) primshcoeff(iprimshell)
! 				write(*,*) iprimshell,chartmp,primshcoeff(iprimshell)
			end if
			shcen(ishell)=iatm
			if (chartmp=="L") then
				shtype(ishell)=-1
			else if (chartmp=="S") then
				shtype(ishell)=0
			else if (chartmp=="P") then
				shtype(ishell)=1
			else if (chartmp=="D") then
				shtype(ishell)=2
			else if (chartmp=="F") then
				shtype(ishell)=3
			else if (chartmp=="G") then
				shtype(ishell)=4
			else if (chartmp=="H") then
				shtype(ishell)=5
			end if
		end if
	end do
end do
allocate(shtypeCar(nbasis)) !Store shell information of Cartesian basis into global array, which may be used later
shtypeCar=shtype

nbasis=0
do ishell=1,nshell
	nbasis=nbasis+shtype2nbas(shtype(ishell))
end do
nbasisCar=nbasis

if (infomode==0) write(*,*) "Loading orbitals..."
call loclabel(10,"----- BETA SET -----",ibeta)
call loclabel(10,"TOTAL NUMBER OF MOS IN VARIATION SPACE=",ispher)
if (ispher==0) then !Cartesian functions
	nmoactual=nbasis
else
	read(10,"(40x,i8)") nmoactual !The actual number of MOs (value is for each spin in unrestricted case), less than nbasis
end if
if (ibeta==0) then !Only one set of orbitals
	nmo=nbasis
	allocate(amocoeff(nbasis,nmoactual),MOocc(nmo),MOene(nmo),MOtype(nmo),MOsym(nmo))
	MOocc=0
	MOene=100
	MOsym="?"
	call loclabel(10,"          EIGENVECTORS",ifound)
    if (ifound==0) then
        write(*,"(a)") " Error: Unable to find orbital coefficients field! The NPRINT parameter must be set to default value"
        write(*,*) "Press ENTER button to exit"
        read(*,*)
        stop
    end if
	call readgmsLCAO(10,ifirefly,nbasis,nmoactual,amocoeff,MOene(1:nmoactual),MOsym(1:nmoactual))
else
	nmo=2*nbasis
	allocate(amocoeff(nbasis,nmoactual),bmocoeff(nbasis,nmoactual),MOocc(nmo),MOene(nmo),MOtype(nmo),MOsym(nmo))
	MOocc=0
	MOene=100
	MOsym="?"
	call loclabel(10,"          EIGENVECTORS",ifound)
    if (ifound==0) then
        write(*,"(a)") " Error: Unable to find orbital coefficients field! The NPRINT parameter must be set to default value"
        write(*,*) "Press ENTER button to exit"
        read(*,*)
        stop
    end if
	call readgmsLCAO(10,ifirefly,nbasis,nmoactual,amocoeff,MOene(1:nmoactual),MOsym(1:nmoactual))
	call loclabel(10,"          EIGENVECTORS",ifound,0) !Don't rewind
	call readgmsLCAO(10,ifirefly,nbasis,nmoactual,bmocoeff,MOene(nbasis+1:nbasis+nmoactual),MOsym(nbasis+1:nbasis+nmoactual))
end if

!Determine the number of electrons and load the number of core electrons replaced with ECP
call loclabel(10,"NUMBER OF OCCUPIED ORBITALS (ALPHA)",ifound)
if (ifirefly==0) read(10,"(47x,f5.0)") naelec
if (ifirefly==1) read(10,"(38x,f5.0)") naelec
call loclabel(10,"NUMBER OF OCCUPIED ORBITALS (BETA )",ifound)
if (ifirefly==0) read(10,"(47x,f5.0)") nbelec
if (ifirefly==1) read(10,"(38x,f5.0)") nbelec
call loclabel(10,"THE ECP RUN REMOVES",iECP,maxline=10000) !ECP is used
if (iECP==1) then
	allocate(zcore(ncenter))
	zcore=0
	rewind(10)
	do while(.true.)
		call loclabel(10,"WITH ZCORE",ifound,0,maxline=10000)
		if (ifound==1) then
			read(10,"(a)") c80
			itmp=index(c80,"ATOM")
			read(c80(itmp+4:),*) iatm
			itmp=index(c80,"ZCORE")
			read(c80(itmp+5:),*) zcore(iatm)
		else
			exit
		end if
	end do
	rewind(10)
	do while(.true.)
		call loclabel(10,"ARE THE SAME AS ATOM",ifound,0,maxline=10000)
		if (ifound==1) then
			read(10,"(a)") c80
			itmp=index(c80,"ATOM")
			read(c80(itmp+4:),*) iatm
			itmp=index(c80,"ATOM",back=.true.)
			read(c80(itmp+4:),*) jatm
			zcore(iatm)=zcore(jatm)
		else
			exit
		end if
	end do
	a%charge=a%charge-zcore !Change "charge" from atom indices to actual number of electrons in ECP calculation
	naelec=naelec-sum(zcore)/2
	nbelec=nbelec-sum(zcore)/2
end if
nelec=naelec+nbelec

!Determine wavefunction type
if (ibeta==0) then
	if (any(MOocc/=nint(MOocc))) then
! 		wfntype=3 !R-post-HF
	else if (naelec/=nbelec) then
		wfntype=2 !ROHF
		MOocc(1:nbelec)=2D0
		MOocc(nbelec+1:naelec)=1D0
		MOtype=0 !Close shell orbital
		MOtype(nbelec+1:naelec)=1
	else !RHF
		wfntype=0
		MOocc(1:naelec)=2D0
		MOtype=0 !Close shell orbital
	end if
else if (ibeta==1) then
	wfntype=1 !UHF
! 	if (any(MOocc/=nint(MOocc))) wfntype=4 !U-post-HF
	MOtype(1:nbasis)=1
	MOtype(nbasis+1:nmo)=2
	MOocc(1:naelec)=1D0
	MOocc(nbasis+1:nbasis+nbelec)=1D0
end if

close(10)

!!!!!! All reading have finished, now generate basis information

!Allocate space for arrays
nprims=0
do i=1,nshell
	nprims=nprims+shtype2nbas(shtype(i))*shcon(i)
end do
allocate(b(nprims),CO(nmo,nprims),basshell(nbasis),bascen(nbasis),bastype(nbasis),primstart(nbasis),&
primend(nbasis),primconnorm(nprims),basstart(ncenter),basend(ncenter))

!Fill Cobasa and CObasb, the gap spaces due to difference between Cartesian and spherical harmonic functions are filled by zero
allocate(CObasa(nbasis,nbasis))
CObasa=0
CObasa(:,1:nmoactual)=amocoeff
if (wfntype==1.or.wfntype==4) then
	allocate(CObasb(nbasis,nbasis))
	CObasb=0
	CObasb(:,1:nmoactual)=bmocoeff
end if

if (infomode==0) write(*,*) "Converting basis function information to GTF information..."
!Distribute exponent, functype to every GTF and generate CO(:,:) from amocoeff/bmocoeff
!Fill: b,basshell,bascen,bastype,co,primstart,primend,primconnorm
k=1 !current position of GTF
iexp=1
ibasis=1 !current position of basis
!Note: Below commented with !!! means the line associated to setting basis information
do i=1,nshell !cycle each basis shell
	b(k:k+shcon(i)*shtype2nbas(shtype(i))-1)%center=shcen(i)
	basshell(ibasis:ibasis+shtype2nbas(shtype(i))-1)=i !!! set basis attributed to which shell
	bascen(ibasis:ibasis+shtype2nbas(shtype(i))-1)=shcen(i) !!! set basis attributed to which center
	do j=1,shtype2nbas(shtype(i)) !cycle each basis function in each basis shell
		b(k:k+shcon(i)-1)%type=s2f(shtype(i),j)
		bastype(ibasis)=s2f(shtype(i),j) !!! set basis type
		primstart(ibasis)=k !!! From where the GTFs attributed to ibasis'th basis
		primend(ibasis)=k+shcon(i)-1 !!! To where the GTFs attributed to ibasis'th basis
		do l=1,shcon(i) !cycle each GTF in each basis function
			b(k)%exp=primshexp(iexp+l-1)
			tnormgau=normgau(b(k)%type,b(k)%exp)  !!!Normalization coefficient of Cartesian GTFs
			temp=primshcoeff(iexp+l-1)  !!!Contraction coefficient of GTFs
			primconnorm(k)=temp*tnormgau !Combines contraction and normalization coefficient
			do imo=1,nmo
				if (wfntype==0.or.wfntype==2.or.wfntype==3) then
					CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
				else if (wfntype==1.or.wfntype==4) then
					if (imo<=nbasis) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
					if (imo>nbasis) CO(imo,k)=CObasb(ibasis,imo-nbasis)*temp*tnormgau
				end if
			end do
			k=k+1
		end do
		ibasis=ibasis+1
	end do
	iexp=iexp+shcon(i)
end do

!Generate basstart and basend
nowcen=0
indcen=0
do ibasis=1,nbasis
	if (bascen(ibasis)/=nowcen) then
		nowcen=bascen(ibasis)
		indcen=indcen+1
		basstart(indcen)=ibasis
		if (indcen/=1) basend(indcen-1)=ibasis-1
	end if
end do
basend(ncenter)=nbasis

!Generate one-particle matrices for basis functions
if (igenP==1) then
	if (infomode==0) write(*,*) "Generating density matrix..."
	call genP
end if
if (infomode==0) write(*,*) "Generating overlap matrix..."
call genSbas_curr

!Output summary of present wavefunction
if (infomode==0) then
	write(*,*)
	write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Net charge:',f12.5,'      Expected multiplicity:',i5)") sum(a(:)%charge)-nelec,nint(naelec-nbelec)+1
	write(*,"(' Atoms:',i7,',  Basis functions:',i7,',  GTFs:',i7)") ncenter,nbasis,nprims
	if (wfntype==0) then
		write(*,"(' This is a restricted single-determinant wavefunction')")
		write(*,"(' Orbitals from 1 to',i6,' are occupied')") nint(nelec/2)
	else if (wfntype==1) then
		write(*,"(' This is an unrestricted single-determinant wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are occupied')") 1,nbasis,1,nint(naelec)
		write(*,"(' Orbitals from ',i6,' to',i6,' are beta,  from',i6,' to',i6,' are occupied')") nbasis+1,nmo,nbasis+1,nbasis+nint(nbelec)
	else if (wfntype==2) then
		write(*,"(' This is a restricted open-shell wavefunction')")
		write(*,"(' Orbitals from',i6,' to',i6,' are doubly occupied')") 1,nint(nbelec)
		write(*,"(' Orbitals from',i6,' to',i6,' are singly occupied')") nint(nbelec)+1,nint(naelec)
	else if (wfntype==3) then
		write(*,"(' This is a restricted multiconfiguration wavefunction')")
	else if (wfntype==4) then
		write(*,"(' This is an unrestricted multiconfiguration wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are beta')") 1,nbasis,nbasis+1,nmo
	end if
end if

call getHOMOidx !Find out index of HOMO, will be used in some cases
end subroutine

!----- A routine used to read GAMESS-US LCAO matrix. One should first move pointer to the line containing "EIGENVECTORS"
subroutine readgmsLCAO(fileid,ifirefly,n1,n2,mat,ene,sym)
implicit real*8(a-h,o-z)
integer fileid,ifirefly,n1,n2
real*8 :: mat(n1,n2),ene(n2)
character*4 :: sym(n2)
character c80tmp*80
read(fileid,*)
read(fileid,*)
ncol=5
nt=ceiling(n2/float(ncol))
do i=1,nt !Number of frames
! 	write(*,*) i !Show frame
	read(fileid,*)
	ns=(i-1)*ncol+1
	if (i/=nt) ne=(i-1)*ncol+ncol
	if (i==nt) ne=n2
	read(fileid,*)

 	!read(fileid,"(a)") c80tmp !Used to debug which frame has problem
 	!write(*,*) trim(c80tmp)
  !  backspace(fileid)

	read(fileid,"(15x)",advance="no")
    !write(*,*) ns,ne,n1 !Debug
	do j=ns,ne
		read(fileid,"(f11.4)",advance="no") ene(j)
	end do
	read(fileid,*)
	read(fileid,*) sym(ns:ne)
	do k=1,n1 !Scan rows in each frame
		read(fileid,"(15x)",advance='no') !Skip marker columns in each row
		do j=ns,ne !Scan elements in each row
 			!write(*,*) i,nt,k,j
			read(fileid,"(f11.6)",advance='no') mat(k,j)
		end do
		read(fileid,*)
	end do
end do
end subroutine

!=======================================================================
!=======================================================================
!!!!!!!!!!!!!!!! Below routines are used to output files !!!!!!!!!!!!!!!
!=======================================================================
!=======================================================================

!!---------- Interface of outputting pdb file
subroutine outpdb_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for outputting pdb file, e.g. C:\ltwd.pdb"
write(*,"(a)") " If press ENTER button directly, the system will be exported to "//trim(c200tmp)//".pdb in current folder"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".pdb"
call outpdb(outname,10)
end subroutine
!!---------- Output current coordinate to pdb file
subroutine outpdb(outpdbname,ifileid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) outpdbname
character prefixname*6
integer ifileid,resid
open(ifileid,file=outpdbname,status="replace")
write(ifileid,"('REMARK   Generated by Multiwfn, Totally',i10,' atoms')") ncenter
if (ifPBC>0) then
    call getcellabc(asize,bsize,csize,alpha,beta,gamma)
    write(ifileid,"('CRYST1',3f9.3,3f7.2)") asize,bsize,csize,alpha,beta,gamma
end if
do i=1,ncenter
    call getprefixname(i,prefixname)
	write(ifileid,"(a6,i5,1x,a4,1x,a3, 1x,a1,i4,4x,3f8.3,2f6.2,10x,a2)") &
	prefixname,i,' '//ind2name_up(a(i)%index)//' ',a(i)%resname, 'A',a(i)%resid,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a,1D0,0D0,adjustr(ind2name_up(a(i)%index))
end do
write(ifileid,"('END')")
close(ifileid)
write(*,*) "Exporting pdb file finished!"
end subroutine

!!---------- Interface of outputting pqr file
subroutine outpqr_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for outputting pqr file, e.g. C:\ltwd.pqr"
write(*,"(a)") " If press ENTER button directly,the system will be exported to "//trim(c200tmp)//".pqr in current folder"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".pqr"
call outpqr(outname,10)
end subroutine
!!---------- Output current coordinate and atomic charges to pqr file
subroutine outpqr(outpqrname,ifileid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) outpqrname
character resname*4,prefixname*6
integer i,ifileid
open(ifileid,file=outpqrname,status="replace")
write(ifileid,"('REMARK   Generated by Multiwfn, Totally',i10,' atoms')") ncenter
if (ifPBC>0) then
    call getcellabc(asize,bsize,csize,alpha,beta,gamma)
    write(ifileid,"('CRYST1',3f9.3,3f7.2)") asize,bsize,csize,alpha,beta,gamma
end if
do i=1,ncenter
    call getprefixname(i,prefixname)
	write(ifileid,"(a6,i5,1x,a4,1x,a3, 1x,a1,i4,4x,3f8.3,f13.8,f9.4,a2)") &
	prefixname,i,' '//ind2name_up(a(i)%index)//' ',a(i)%resname, 'A',a(i)%resid,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a,a(i)%charge,vdwr(a(i)%index)*b2a,adjustr(ind2name_up(a(i)%index))
end do
write(ifileid,"('END')")
close(ifileid)
write(*,*) "Exporting pqr file finished!"
write(*,"(a)") " This file contains atomic charges that originally recorded in your .chg file. The radius column corresponds to Bondi vdW radii"
end subroutine

!!-------- Determine "ATOM" or "HETATM" of an atom
subroutine getprefixname(iatm,prefixname)
use defvar
character prefixname*6,tmpname*3
integer iatm
prefixname="HETATM"
tmpname=adjustl(a(iatm)%resname)
if (tmpname=="ASP".or.tmpname=="GLU".or.tmpname=="HIS".or.tmpname=="LYS".or.tmpname=="ARG".or.&
    tmpname=="ASN".or.tmpname=="GLN".or.tmpname=="SER".or.tmpname=="THR".or.tmpname=="CYS".or.&
    tmpname=="VAL".or.tmpname=="ALA".or.tmpname=="LEU".or.tmpname=="PHE".or.tmpname=="TYR".or.&
    tmpname=="MET".or.tmpname=="ILE".or.tmpname=="PRO".or.tmpname=="GLY".or.tmpname=="TRP") then
    prefixname="ATOM  "
end if
end subroutine

!!---------- Interface of outputting xyz file
subroutine outxyz_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for outputting xyz file, e.g. C:\ltwd.xyz"
write(*,"(a)") " If press ENTER button directly, the system will be exported to "//trim(c200tmp)//".xyz in current folder"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".xyz"
call outxyz(outname,10)
end subroutine
!!---------- Output current coordinate to xyz file
subroutine outxyz(outxyzname,ifileid)
use defvar
character(len=*) outxyzname
integer i,ifileid
open(ifileid,file=outxyzname,status="replace")
write(ifileid,"(i6)") ncenter
if (ifPBC==0) then
    write(ifileid,*) "Generated by Multiwfn"
else !Write cell translation vectors, e.g. Tv_1:   9.901260   0.000000   0.000000 Tv_2:  -4.879808   8.533788   0.000000 Tv_3:   0.000000   0.000000  10.000000
    if (ifPBC==1) write(ifileid,"(' Tv_1:',3f11.6)") cellv1*b2a
    if (ifPBC==2) write(ifileid,"(' Tv_1:',3f11.6,' Tv_2:',3f11.6)") cellv1*b2a,cellv2*b2a
    if (ifPBC==3) write(ifileid,"(' Tv_1:',3f11.6,' Tv_2:',3f11.6,' Tv_3:',3f11.6)") cellv1*b2a,cellv2*b2a,cellv3*b2a
end if
do i=1,ncenter
	write(ifileid,"(a,3f16.8)") ind2name(a(i)%index),a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
close(ifileid)
write(*,*) "Exporting xyz file finished!"
end subroutine

!!---------- Output current coordinate to cml file
!iunit=0: In Angstrom, iunit=1: In Bohr
subroutine outcml(outcmlname,ifileid,iunit)
use defvar
character(len=*) outcmlname
character tmpstr1*80,tmpstr2*80,tmpstr3*80,tmpstr4*80
integer i,ifileid,iunit
if (.not.allocated(connmat)) call genconnmat(1,0) !Generate connectivity matrix

open(ifileid,file=outcmlname,status="replace")
write(ifileid,"(a)") '<molecule>'
write(ifileid,"(a)") ' <atomArray>'
fac=1
if (iunit==0) fac=b2a !Convert to Angstrom

do i=1,ncenter
    write(tmpstr1,*) i
    write(tmpstr2,"(f12.6)") a(i)%x*fac
    write(tmpstr3,"(f12.6)") a(i)%y*fac
    write(tmpstr4,"(f12.6)") a(i)%z*fac
    write(ifileid,"(a)") &
    '  <atom id="a'//trim(adjustl(tmpstr1))//'" elementType="'//trim(adjustl(a(i)%name))//'" x3="'//trim(adjustl(tmpstr2))&
    //'" y3="'//trim(adjustl(tmpstr3))//'" z3="'//trim(adjustl(tmpstr4))//'"/>'
end do
write(ifileid,"(a)") ' </atomArray>'
write(ifileid,"(a)") ' <bondArray>'
do i=1,ncenter
    do j=i+1,ncenter
        if (connmat(i,j)>0) then
            write(tmpstr1,*) i
            write(tmpstr2,*) j
            write(tmpstr3,*) connmat(i,j)
            write(ifileid,"(a)") '  <bond atomRefs2="a'//trim(adjustl(tmpstr1))//' a'//&
            trim(adjustl(tmpstr2))//'" order="'//trim(adjustl(tmpstr3))//'"/>'
        end if
    end do
end do
write(ifileid,"(a)") ' </bondArray>'
write(ifileid,"(a)") '</molecule>'

close(ifileid)
write(*,*) "Exporting cml file finished!"
end subroutine

!!---------- Output current coordinate to chg file
subroutine outchg(outchgname,ifileid)
use defvar
character(len=*) outchgname
integer i,ifileid
open(ifileid,file=outchgname,status="replace")
do i=1,ncenter
	write(ifileid,"(a,4f16.8)") ind2name(a(i)%index),a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a,a(i)%charge
end do
close(ifileid)
write(*,*) "Exporting chg file finished!"
end subroutine

!!---------- Interface of outputting Gaussian input file
subroutine outgjf_wrapper
use util
use defvar
character*200 outname,c200tmp
integer :: icoordtype=1 !1=Cartesian   2=Z-matrix with variable names   -2=Z-matrix directly with geometry parameters
call path2filename(filename,c200tmp)
do while(.true.)
    write(*,*)
    write(*,*) "Input path for generating Gaussian input file, e.g. C:\ltwd.gjf"
    write(*,"(a)") " If press ENTER button directly, "//trim(c200tmp)//".gjf will be generated in current folder"
    if (ifPBC==0) then
        if (icoordtype==1) then
            write(*,"(a)") " Note: Cartesian coordinate will be outputted. If you want to output Z-matrix instead, input ""zmat"""
        else if (icoordtype==2) then
            write(*,"(a)") " Note: Z-matrix will be outputted with variable names. If you want to output Cartesian coordinates instead, input ""cart""; &
            if you want to output geometry parameters without variable names, input ""zmat2"""
        else if (icoordtype==-2) then
            write(*,"(a)") " Note: Z-matrix will be outputted without variable names. If you want to output Cartesian coordinates instead, input ""cart""; &
            if you want to output geometry parameters with variable names, input ""zmat1"""
        end if
    end if
    if (icoordtype==1) write(*,"(a)") " Hint: If template.gjf is presented in current folder, &
    then it will be used as template file and the line containing [geometry] will be replaced with the present coordinate, &
    and [name] will be replaced with name (without suffix) of the new input file"
    read(*,"(a)") outname
    if (outname=="zmat".or.outname=="zmat1") then
        icoordtype=2
    else if (outname=="zmat2") then
        icoordtype=-2
    else if (outname=="cart") then
        icoordtype=1
    else if (outname==" ") then
        outname=trim(c200tmp)//".gjf"
        exit
    else
        exit
    end if
end do
call outgjf(outname,10,icoordtype)
end subroutine
!!---------- Output current coordinate to Gaussian input file
!1=Cartesian   2=Z-matrix with variable names   -2=Z-matrix directly with geometry parameters
subroutine outgjf(outgjfname,ifileid,icoordtype)
use defvar
use util
character(len=*) outgjfname
character selectyn,c10tmp*10,tmpname*200,c200tmp*200
integer icoordtype,Zmat(ncenter,3)
character bondstr*6(ncenter),anglestr*6(ncenter),dihstr*6(ncenter)
real*8 bondval(ncenter),angleval(ncenter),dihval(ncenter)
real*8 atomdist

if (icoordtype==1) then !In the case of Cartesian coordinate, if template.gjf exists, using it as template
    inquire(file="template.gjf",exist=alive)
    if (alive) then
        write(*,"(a)") " Note: template.gjf was found in current folder, it will be used as template file to generate new .gjf file"
        open(ifileid,file=outgjfname,status="replace")
        open(ifileid+1,file="template.gjf",status="old")
        do while(.true.)
            read(ifileid+1,"(a)",iostat=ierror) c200tmp
            if (ierror==0) then
                if (index(c200tmp,"[geometry]")/=0) then
                    do i=1,ncenter
	                    write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
                    end do
                else
                    itmp=index(c200tmp,"[name]")
                    if (itmp/=0) then
                        call path2filename(outgjfname,tmpname)
                        c200tmp=c200tmp(1:itmp-1)//trim(tmpname)//trim(c200tmp(itmp+6:))
                    end if
                    write(ifileid,"(a)") trim(c200tmp)
                end if
            else
                exit
            end if
        end do
        close(ifileid)
        close(ifileid+1)
        write(*,"(a)") " Exporting Gaussian input file finished!"
        return
    end if
end if

selectyn='n'
if (allocated(CObasa).and.wfntype<=2) then
    write(*,"(a)") " Do you also want to write current wavefunction as initial guess into the .gjf file? (y/n)"
    read(*,*) selectyn
end if

if (abs(icoordtype)==2) then
    call genZmat(Zmat,ierror)
    if (ierror==1) then
        write(*,"(a)") " Error: Generation of internal coordinate is failed! May be this system cannot be properly represented by internal coordinate"
        write(*,*) "Press ENTER button to return"
        read(*,*)
        return
    end if
end if

call path2filename(outgjfname,tmpname)
open(ifileid,file=outgjfname,status="replace")
write(ifileid,"(a)") "%chk="//trim(tmpname)//".chk"
if (selectyn=='y'.or.selectyn=='Y') then
    write(ifileid,"(a,/,/,a,/)") "#P B3LYP/6-31G* guess=cards","Generated by Multiwfn"
else
    write(ifileid,"(a,/,/,a,/)") "#P B3LYP/6-31G*","Generated by Multiwfn"
end if
if (loadcharge==-99) then !Not loaded from input file
    netcharge=nint(sum(a%charge)-nelec)
    if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
else
    netcharge=loadcharge
end if
if (loadmulti==-99) then !Not loaded from input file
    multi=nint(naelec-nbelec)+1
else
    multi=loadmulti
end if
write(ifileid,"(2i3)") netcharge,multi

if (icoordtype==1) then !Cartesian
    do i=1,ncenter
	    write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
    end do
else if (icoordtype==2) then !Z-matrix with variable names
    nbond=0
    nangle=0
    ndih=0
    write(ifileid,"(a)") a(1)%name
    do iatm=2,ncenter
        write(ifileid,"(a)",advance="no") a(iatm)%name
        nbond=nbond+1
        write(c10tmp,"(i5)") nbond
        bondstr(nbond)="B"//trim(adjustl(c10tmp))
        i1=zmat(iatm,1)
        bondval(nbond)=atomdist(iatm,i1)*b2a
        write(ifileid,"(i5,3x,a)",advance="no") zmat(iatm,1),bondstr(nbond)
        if (iatm>=3) then
            nangle=nangle+1
            write(c10tmp,"(i5)") nangle
            anglestr(nangle)="A"//trim(adjustl(c10tmp))
            i2=zmat(iatm,2)
            angleval(nangle)=xyz2angle(a(iatm)%x,a(iatm)%y,a(iatm)%z,a(i1)%x,a(i1)%y,a(i1)%z,a(i2)%x,a(i2)%y,a(i2)%z)
            write(ifileid,"(3x,i5,3x,a)",advance="no") zmat(iatm,2),anglestr(nangle)
            if (iatm>=4) then
                ndih=ndih+1
                write(c10tmp,"(i5)") ndih
                dihstr(ndih)="D"//trim(adjustl(c10tmp))
                i3=zmat(iatm,3)
                !write(*,*) iatm,i1,i2,i3
                dihval(ndih)=xyz2dih_sign(a(iatm)%x,a(iatm)%y,a(iatm)%z,a(i1)%x,a(i1)%y,a(i1)%z,a(i2)%x,a(i2)%y,a(i2)%z,a(i3)%x,a(i3)%y,a(i3)%z)
                !write(*,*) ndih,dihval(ndih)
                write(ifileid,"(3x,i5,3x,a)",advance="no") zmat(iatm,3),trim(dihstr(ndih))
            end if
        end if
        write(ifileid,*)
    end do
    write(ifileid,*)
    do ibond=1,nbond
        write(ifileid,"(a,f15.8)") bondstr(ibond),bondval(ibond)
    end do
    do iangle=1,nangle
        write(ifileid,"(a,f15.8)") anglestr(iangle),angleval(iangle)
    end do
    do idih=1,ndih
        write(ifileid,"(a,f15.8)") dihstr(idih),dihval(idih)
    end do
else if (icoordtype==-2) then !Z-matrix directly with geometry parameters
    write(ifileid,"(a)") a(1)%name
    do iatm=2,ncenter
        write(ifileid,"(a)",advance="no") a(iatm)%name
        i1=zmat(iatm,1)
        write(ifileid,"(i5,f12.6)",advance="no") zmat(iatm,1),atomdist(iatm,i1)*b2a
        if (iatm>=3) then
            i2=zmat(iatm,2)
            tmpval=xyz2angle(a(iatm)%x,a(iatm)%y,a(iatm)%z,a(i1)%x,a(i1)%y,a(i1)%z,a(i2)%x,a(i2)%y,a(i2)%z)
            write(ifileid,"(3x,i5,f10.4)",advance="no") zmat(iatm,2),tmpval
            if (iatm>=4) then
                i3=zmat(iatm,3)
                tmpval=xyz2dih_sign(a(iatm)%x,a(iatm)%y,a(iatm)%z,a(i1)%x,a(i1)%y,a(i1)%z,a(i2)%x,a(i2)%y,a(i2)%z,a(i3)%x,a(i3)%y,a(i3)%z)
                write(ifileid,"(3x,i5,f10.4)",advance="no") zmat(iatm,3),tmpval
            end if
        end if
        write(ifileid,*)
    end do
end if

if (any(cellv1/=0)) write(ifileid,"('Tv',3f12.6)") cellv1*b2a
if (any(cellv2/=0)) write(ifileid,"('Tv',3f12.6)") cellv2*b2a
if (any(cellv3/=0)) write(ifileid,"('Tv',3f12.6)") cellv3*b2a
if (selectyn=='y') then
    write(ifileid,"(/,'(5E16.9)',/,'-1')")
    do i=1,nbasis
	    if (wfntype==0.or.wfntype==2) write(ifileid,"('! Orbital:',i6,' Occ:',f10.6)") i,MOocc(i)
	    if (wfntype==1) write(ifileid,"('! Alpha orbital:',i6,' Occ:',f10.6)") i,MOocc(i)
	    write(ifileid,"(5E16.9)") (CObasa(j,i),j=1,nbasis)
    end do
    if (wfntype==1) then
	    write(ifileid,"('-1')")
	    do i=1,nbasis
		    write(ifileid,"('! Beta orbital:',i6,' Occ:',f10.6)") i,MOocc(nbasis+i)
		    write(ifileid,"(5E16.9)") (CObasb(j,i),j=1,nbasis)
	    end do
    end if
    write(ifileid,"('0',/)")
end if
write(ifileid,*)  !Two blank lines at the end of the file
close(ifileid)
write(*,"(a)") " Exporting Gaussian input file finished! It corresponds to single point task at B3LYP/6-31G* level"
if (selectyn=='y') write(*,"(a)") " Note that you must specify the basis set to the one &
originally used to yield the wavefunction, otherwise Gaussian calculation must be failed"
end subroutine

!!---------- Output current coordinate to GAMESS-US input file
!The level exactly corresponds to the B3LYP-D3(BJ)/6-31G* of Gaussian
subroutine outGAMESSinp(outname,ifileid)
use defvar
character(len=*) outname
character SCFTYPE*3,selectyn
ioutguess=0
if (allocated(CObasa)) then
	write(*,*) "If write initial guess information? (y/n)"
	read(*,*) selectyn
	if (selectyn=='y'.or.selectyn=='Y') ioutguess=1
end if
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
mult=nint(naelec-nbelec)+1
iopsh=0
if (mult/=1.or.wfntype==1.or.wfntype==4) iopsh=1
SCFTYPE="RHF"
if (iopsh==1) SCFTYPE="UHF"
open(ifileid,file=outname,status="replace")
write(ifileid,"(a,i1,a,i1,a)") " $CONTRL SCFTYP="//SCFTYPE//" MULT=",mult," ICHARG=",netcharge," RUNTYP=ENERGY"
write(ifileid,"(a)") " DFTTYP=B3LYPV1R ISPHER=0 MAXIT=60 NPRINT=-5 $END"
write(ifileid,"(a)") " $BASIS GBASIS=N31 NGAUSS=6 NDFUNC=1 NPFUNC=0 DIFFSP=.F. DIFFS=.F. $END"
write(ifileid,"(a)") " $SYSTEM MWORDS=200 $END"
!  $lmoeda matom(1)=3,4 mcharg(1)=0,0 mmult(1)=1,1 $end
write(ifileid,"(a)") " $SCF DIRSCF=.T. $END"
write(ifileid,"(a)") " $DFT IDCVER=4 $END"
if (ioutguess==1) write(ifileid,"(a,i5,a)") " $GUESS GUESS=MOREAD NORB=",nbasis," $END"
write(ifileid,"(a)") " $DATA"
write(ifileid,"(a)") "Generated by Multiwfn"
write(ifileid,"(a)") "C1"
do i=1,ncenter
	write(ifileid,"(a,1x,f5.1,1x,3f14.8)") a(i)%name,dfloat(a(i)%index),a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,"(a)") " $END"
! Write $VEC information
if (ioutguess==1) then
	write(ifileid,*)
	write(ifileid,"(a)") " $VEC"
	ntime=ceiling(nbasis/5D0)
	idxmo=1
	do imo=1,nbasis
		do itime=1,ntime
			if (itime<ntime) then
				write(ifileid,"(i2,i3,5(1PE15.8))") idxmo,itime,CObasa((itime-1)*5+1:itime*5,imo)
			else
				write(ifileid,"(i2,i3,5(1PE15.8))") idxmo,itime,CObasa((itime-1)*5+1:nbasis,imo)
			end if
		end do
		idxmo=idxmo+1
		if (idxmo==100) idxmo=0
	end do
	if (iopsh==1) then
		idxmo=1
		do imo=1,nbasis
			do itime=1,ntime
				if (itime<ntime) then
					write(ifileid,"(i2,i3,5(1PE15.8))") idxmo,itime,CObasb((itime-1)*5+1:itime*5,imo)
				else
					write(ifileid,"(i2,i3,5(1PE15.8))") idxmo,itime,CObasb((itime-1)*5+1:nbasis,imo)
				end if
			end do
			idxmo=idxmo+1
			if (idxmo==100) idxmo=0
		end do
	end if
	write(ifileid,"(a)") " $END"
end if
close(ifileid)
write(*,"(a)") " Exporting GAMESS-US input file finished! It corresponds to single point task at B3LYP-D3(BJ)/6-31G* level"
end subroutine

!!---------- Interface of outputting ORCA input file
subroutine outORCAinp_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,"(/,a)") " Note: If you benefit from this function when creating ORCA input file, please cite Multiwfn original paper, thanks!"
write(*,*)
write(*,*) "Input path for generating ORCA input file, e.g. C:\ltwd.inp"
write(*,"(a)") " If press ENTER button directly, will be exported to "//trim(c200tmp)//".inp"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".inp"
call outORCAinp(outname,10)
end subroutine
!!---------- Output current coordinate to ORCA input file
subroutine outORCAinp(outname,ifileid)
use defvar
use util
character(len=*) outname
character keyword*200,c80tmp*80,c200tmp*200,solvname*30,c2000tmp*2000,grd4str*20,grd5str*20
integer :: itask=1,idiffuse=0,frozenatm(ncenter),CPfrag1(ncenter),CPfrag2(ncenter),ioptHonly=0
integer :: maxcore=1000
integer :: iORCAver=1 !ORCA version, =0: 4.x, =1: 5.0
real*8 efield(3)
nprocs=nthreads
isolv=0
nfrozenatm=0
efield=0

do while(.true.)
    write(*,*)
    write(*,*) "-100 Use template input file provided by user to generate new input file"
    if (iORCAver==0) write(*,*) "-11 Choose ORCA version compatibility, current: ORCA 4.x"
    if (iORCAver==1) write(*,*) "-11 Choose ORCA version compatibility, current: >ORCA 5.0"
    write(*,"(a,i4,a,i6,a)") " -10 Set computational resources, core:",nprocs," memory/core:",maxcore," MB"
    write(*,*) "-4 Other settings"
    if (itask==2.or.itask==4.or.itask==5) then
        if (ioptHonly==0) then
            write(*,"(a,', current:',i6' atoms')") " -3 Set atom freeze in optimization",nfrozenatm
        else if (ioptHonly==1) then
            write(*,"(a)") " -3 Set atom freeze in optimization, current: Only optimize hydrogens"
        end if
    end if
    if (idiffuse==1) write(*,*) "-2 Toggle adding diffuse functions, current: Yes"
    if (idiffuse==0) write(*,*) "-2 Toggle adding diffuse functions, current: No"
    if (isolv==0) write(*,*) "-1 Toggle employing implicit solvation model, current: No"
    if (isolv==1) write(*,*) "-1 Toggle employing implicit solvation model, current: SMD, "//trim(solvname)
    if (isolv==2) write(*,*) "-1 Toggle employing implicit solvation model, current: CPCM, "//trim(solvname)
    if (itask==1) write(*,*) "0 Select task, current: Single point"
    if (itask==2) write(*,*) "0 Select task, current: Optimizing minimum"
    if (itask==3) write(*,*) "0 Select task, current: Frequency analysis"
    if (itask==4) write(*,*) "0 Select task, current: Optimizing minimum + Frequency"
    if (itask==5) write(*,*) "0 Select task, current: Optimizing TS + Frequency"
    if (itask==6) write(*,*) "0 Select task, current: Molecular dynamics"
    if (itask==7) write(*,*) "0 Select task, current: Interaction energy with counterpoise correction"
    if (itask==8) write(*,*) "0 Select task, current: NMR"
    if (itask==9) write(*,*) "0 Select task, current: Wavefunction stability test"
    !With b suffix, the internal index is original index plus 1000
    if (iORCAver==0) write(*,*) "1 B97-3c"
    if (iORCAver==1) write(*,*) "1 B97-3c      1b r2SCAN-3c"
    write(*,*) "2 RI-BLYP-D3(BJ)/def2-TZVP"
    write(*,*) "3 RI-B3LYP-D3(BJ)/def2-TZVP(-f)     4 RI-B3LYP-D3(BJ)/def2-TZVP"
    write(*,*) "5 RI-wB97M-V/def2-TZVP"
    write(*,*) "6 RI-PWPB95-D3(BJ)/def2-TZVPP       7 RI-PWPB95-D3(BJ)/def2-QZVPP"
    if (iORCAver==1) write(*,*) "6b RI-wB97X-2-D3(BJ)/def2-TZVPP     7b RI-wB97X-2-D3(BJ)/def2-QZVPP"
    write(*,*) "8 DLPNO-CCSD(T)/cc-pVTZ with normalPNO and RIJK"
    write(*,*) "9 DLPNO-CCSD(T)/cc-pVTZ with tightPNO and RIJK"
    write(*,*) "10 CCSD(T)/cc-pVTZ"
    write(*,*) "11 CCSD(T)-F12/cc-pVDZ-F12 with RI"
    write(*,*) "12 Approximated CCSD(T)/CBS with help of MP2 (cc-pVTZ->QZ extrapolation)"
    if (idiffuse==0) write(*,*) "13 DLPNO-CCSD(T)/CBS with tightPNO and RIJK (def2-TZVPP->QZVPP extrapolation)"
    write(*,*) "14 CCSD(T)/CBS (cc-pVTZ->QZ extrapolation)"
    write(*,*) "20 sTD-DFT based on RI-wB97X-D3/def2-SV(P) orbitals"
    write(*,*) "21 TDA-DFT RI-PBE0/def2-SV(P) with riints_disk (much faster than 22)"
    write(*,*) "22 TDDFT RI-PBE0/def2-SV(P)"
    write(*,*) "23 TDDFT RI-wB2GP-PLYP/def2-TZVP    231 TDDFT RI-DSD-PBEP86/def2-TZVP"
    write(*,*) "24 EOM-CCSD/cc-pVTZ                 25 STEOM-DLPNO-CCSD/def2-TZVP"
    read(*,"(a)") c80tmp
    if (c80tmp=="1b") then
        ilevel=1001
    else if (c80tmp=="6b") then
        ilevel=1006
    else if (c80tmp=="7b") then
        ilevel=1007
    else
        read(c80tmp,*) ilevel
    end if
    if (ilevel==-100) then
        do while(.true.)
            write(*,*) "Input the path of template input file, e.g. /sob/Bang/Dream.inp"
            write(*,"(a)") " Note: The template input file should contain all content of finally generated input file, &
            but coordinate part should be written as [geometry], which will be replaced with geometry of present system"
	        read(*,"(a)") c200tmp
	        inquire(file=c200tmp,exist=alive)
	        if (alive) exit
	        write(*,*) "Cannot find the file, input again!"
        end do
        open(ifileid,file=outname,status="replace")
        open(ifileid+1,file=c200tmp,status="old")
        do while(.true.)
            read(ifileid+1,"(a)",iostat=ierror) c200tmp
            if (ierror/=0) exit
            if (index(c200tmp,"[geometry]")/=0) then
                do iatm=1,ncenter
                    write(ifileid,"(a,1x,3f14.8)") a(iatm)%name,a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
                end do
            else
                write(ifileid,"(a)") trim(c200tmp)
            end if
        end do
        close(ifileid)
        close(ifileid+1)
        write(*,"(a)") " Done! "//trim(outname)//" has been generated"
        return
    else if (ilevel==-11) then
        write(*,*) "Choose ORCA version compatibility"
        write(*,*) "0 I am using ORCA 4.x"
        write(*,*) "1 I am using ORCA 5.0 or newer"
        read(*,*) iORCAver
    else if (ilevel==0) then
        write(*,*) "1 Single point"
        write(*,*) "2 Optimization"
        write(*,*) "3 Frequency"
        write(*,*) "4 Optimization + Frequency"
        write(*,*) "5 Optimization for transition state + Frequency"
        write(*,*) "6 Molecular dynamics"
        write(*,*) "7 Interaction energy with counterpoise correction"
        write(*,*) "8 NMR"
        write(*,*) "9 Wavefunction stability test"
        read(*,*) itask
        if (itask==7) then
            write(*,*) "Input indices of the atoms in fragment 1, e.g. 3,6-10,14"
            read(*,"(a)") c2000tmp
            call str2arr(c2000tmp,nCPfrag1,CPfrag1)
            write(*,*) "Input indices of the atoms in fragment 2, e.g. 1,2,4,5,11-13"
            read(*,"(a)") c2000tmp
            call str2arr(c2000tmp,nCPfrag2,CPfrag2)
        end if
    else if (ilevel==-1) then
        if (isolv/=0) then
            isolv=0
        else
            write(*,"(a)") " Input name of solvent for SMD solvation model, e.g. ethanol. The full list of available solvents can be found in ""The SMD Solvation Model"" of ORCA manual"
            write(*,*) "If press ENTER button directly, water will be employed as solvent"
            write(*,*) "If you want to use CPCM solvation model or use custom solvent, input ""c"""
            read(*,"(a)") solvname
            isolv=1
            if (solvname==" ") then
                solvname="water"
            else if (solvname=='c') then
                isolv=2
                write(*,"(a)") " Input name of one of supported solvents: Water, Acetone, Acetonitrile, Ammonia, &
                Benzene, CCl4, CH2Cl2, Chloroform, Cyclohexane, DMF, DMSO, Ethanol, Hexane, Methanol, Octanol, Pyridine, THF, Toluene"
                write(*,*) "If you want to defined custom solvent, input ""c"""
                read(*,*) solvname
                if (solvname=="c") then
                    write(*,*) "Input dielectic constant, e.g. 80"
                    read(*,*) diecons
                    write(*,*) "Input refractive index, e.g. 1.8"
                    write(*,*) "If actual value is known, usually 1.33 is an acceptable approximation"
                    read(*,*) refrac
                    solvname="custom"
                end if
            end if
        end if
    else if (ilevel==-2) then
        if (idiffuse==1) then
            idiffuse=0
        else
            idiffuse=1
        end if
    else if (ilevel==-3) then
        write(*,*) "Input the atoms to be frozen during optimization, e.g. 3,5-10,13,15"
        write(*,"(a)") " Note: The index starts from 1 (Multiwfn convention) rather than 0 (ORCA convention)"
        write(*,*) "If you only want to optimize hydrogens, input ""H"""
        read(*,"(a)") c2000tmp
        if (index(c2000tmp,'H')/=0) then
            ioptHonly=1
        else
            ioptHonly=0
            call str2arr(c2000tmp,nfrozenatm,frozenatm)
        end if
    else if (ilevel==-4) then
        do while(.true.)
            write(*,*)
            write(*,*) "0 Return"
            write(*,"(a,3f10.6,' a.u.')") " 1 Set external electric field, current:",efield(:)
            read(*,*) isel2
            if (isel2==0) then
                exit
            else if (isel2==1) then
                write(*,*) "Write X/Y/Z of external electric field vector in a.u., e.g. 0.002,0,0.0015"
                read(*,*) efield
            end if
        end do
    else if (ilevel==-10) then
        write(*,*) "Input number of cores, e.g. 12"
        write(*,"(' If press ENTER button directly, current value',i4,' will be unchanged')") nprocs
        read(*,"(a)") c80tmp
        if (c80tmp/=" ") read(c80tmp,*) nprocs
        write(*,*) "Input usable memory per core, e.g. 1000 (in MB)"
        write(*,"(' If press ENTER button directly, current value',i6,' will be unchanged')") maxcore
        read(*,"(a)") c80tmp
        if (c80tmp/=" ") read(c80tmp,*) maxcore
    else
        exit
    end if
end do

grd4str=" grid4 gridx4"
grd5str=" grid5 gridx5"
if (iORCAver==1) then !Since ORCA 5.0, the default grid is defgrid2, and grid/gridx keyword is inacceptable
    grd4str=" "
    grd5str=" "
end if
if (idiffuse==0) then
    if (ilevel==1) c200tmp="! B97-3c"
    if (ilevel==1001) c200tmp="! r2SCAN-3c"
    if (ilevel==2) c200tmp="! BLYP D3 def2-TZVP def2/J" !For pure functional, RIJ is used by default even without def2/J
    if (ilevel==3) c200tmp="! B3LYP D3 def2-TZVP(-f) def2/J RIJCOSX"
    if (ilevel==4) c200tmp="! B3LYP D3 def2-TZVP def2/J RIJCOSX"
    if (ilevel==5) c200tmp="! wB97M-V def2-TZVP def2/J RIJCOSX strongSCF"//trim(grd5str)
    if (ilevel==6) c200tmp="! PWPB95 D3 def2-TZVPP def2/J def2-TZVPP/C RIJCOSX tightSCF"//trim(grd4str) !When RIJCOSX or RIJK is used, the MP2 will also use RI by default
    if (ilevel==7) c200tmp="! PWPB95 D3 def2-QZVPP def2/J def2-QZVPP/C RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==1006) c200tmp="! wB97X-2 D3 def2-TZVPP def2/J def2-TZVPP/C RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==1007) c200tmp="! wB97X-2 D3 def2-QZVPP def2/J def2-QZVPP/C RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==8) c200tmp="! DLPNO-CCSD(T) normalPNO RIJK cc-pVTZ cc-pVTZ/JK cc-pVTZ/C tightSCF"
    if (ilevel==9) c200tmp="! DLPNO-CCSD(T) tightPNO RIJK cc-pVTZ cc-pVTZ/JK cc-pVTZ/C tightSCF"
    if (ilevel==10) c200tmp="! CCSD(T) cc-pVTZ tightSCF"
    if (ilevel==11) c200tmp="! CCSD(T)-F12/RI cc-pVDZ-F12 cc-pVDZ-F12-CABS cc-pVTZ/C tightSCF"
    if (ilevel==12) c200tmp="! ExtrapolateEP2(3/4,cc,MP2) tightSCF"
    if (ilevel==13) c200tmp="! DLPNO-CCSD(T) tightPNO Extrapolate(3/4,def2) RIJK def2/JK tightSCF"
    if (ilevel==14) c200tmp="! CCSD(T) Extrapolate(3/4,cc) tightSCF"
    if (ilevel==20) c200tmp="! wB97X-D3 def2-SV(P) def2/J RIJCOSX"
    if (ilevel==21) c200tmp="! PBE0 def2-SV(P) def2/J def2-SVP/C RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==22) c200tmp="! PBE0 def2-SV(P) def2/J RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==23) c200tmp="! wB2GP-PLYP def2-TZVP def2/J def2-TZVP/C RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==231) c200tmp="! DSD-PBEP86 def2-TZVP def2/J def2-TZVP/C RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==24) c200tmp="! EOM-CCSD cc-pVTZ tightSCF"
    if (ilevel==25) c200tmp="! STEOM-DLPNO-CCSD RIJK def2-TZVP def2/JK def2-TZVP/C tightSCF"
else
    if (ilevel==1) c200tmp="! B97-3c"
    if (ilevel==1001) c200tmp="! r2SCAN-3c"
    if (ilevel==2) c200tmp="! BLYP D3 ma-def2-TZVP autoaux"
    if (ilevel==3) c200tmp="! B3LYP D3 ma-def2-TZVP(-f) autoaux RIJCOSX"
    if (ilevel==4) c200tmp="! B3LYP D3 ma-def2-TZVP autoaux RIJCOSX"
    if (ilevel==5) c200tmp="! wB97M-V ma-def2-TZVP autoaux RIJCOSX strongSCF"//trim(grd5str)
    if (ilevel==6) c200tmp="! PWPB95 D3 ma-def2-TZVPP autoaux RIJCOSX tightSCF"//trim(grd4str) !When RIJCOSX or RIJK is used, the MP2 will also use RI by default
    if (ilevel==7) c200tmp="! PWPB95 D3 ma-def2-QZVPP autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==1006) c200tmp="! wB97X-2 D3 ma-def2-TZVPP autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==1007) c200tmp="! wB97X-2 D3 ma-def2-QZVPP autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==8) c200tmp="! DLPNO-CCSD(T) normalPNO RIJK aug-cc-pVTZ aug-cc-pVTZ/JK aug-cc-pVTZ/C tightSCF"
    if (ilevel==9) c200tmp="! DLPNO-CCSD(T) tightPNO RIJK aug-cc-pVTZ aug-cc-pVTZ/JK aug-cc-pVTZ/C tightSCF"
    if (ilevel==10) c200tmp="! CCSD(T) aug-cc-pVTZ tightSCF"
    if (ilevel==11) c200tmp="! CCSD(T)-F12/RI cc-pVDZ-F12 cc-pVDZ-F12-CABS cc-pVTZ/C"
    if (ilevel==12) c200tmp="! ExtrapolateEP2(3/4,aug-cc,MP2) tightSCF"
    !This is unavailable when diffuse function is requested
    !if (ilevel==13) c200tmp="! DLPNO-CCSD(T) tightPNO Extrapolate(3/4,def2) RIJK def2/JK tightSCF
    if (ilevel==14) c200tmp="! CCSD(T) Extrapolate(3/4,aug-cc) tightSCF"
    if (ilevel==20) c200tmp="! wB97X-D3 ma-def2-SV(P) autoaux RIJCOSX"
    if (ilevel==21) c200tmp="! PBE0 ma-def2-SV(P) autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==22) c200tmp="! PBE0 ma-def2-SV(P) autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==23) c200tmp="! wB2GP-PLYP ma-def2-TZVP autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==231) c200tmp="! DSD-PBEP86 ma-def2-TZVP autoaux RIJCOSX tightSCF"//trim(grd4str)
    if (ilevel==24) c200tmp="! EOM-CCSD aug-cc-pVTZ tightSCF"
    if (ilevel==25) c200tmp="! STEOM-DLPNO-CCSD RIJK ma-def2-TZVP autoaux tightSCF"

    if (ilevel==1.or.ilevel==11) then
        write(*,*) "Error: Diffuse functions cannot be added to this level!"
        write(*,*) "Press ENTER button to return"
        read(*,*)
        return
    end if
end if

if (itask==7.and.isolv/=0) then
    write(*,*) "Error: It is meaningless to perform counterpoise calculation with solvation model!"
    write(*,*) "Press ENTER button to return"
    read(*,*)
    return
end if

!Generate keywords
if (itask==2) then !opt task uses tightSCF by default
    keyword=trim(c200tmp)//" opt"
    if (ilevel==22.and.idiffuse==0) keyword=trim(keyword)//" def2-SVP/C" !RI-TDDFT opt must use /C
else if (itask==3) then !freq
    if (index(c200tmp,"tightSCF")==0) then
        keyword=trim(c200tmp)//" freq tightSCF"
    else
        keyword=trim(c200tmp)//" freq"
    end if
else if (itask==4) then !opt freq
    if (index(c200tmp,"tightSCF")==0) then
        keyword=trim(c200tmp)//" opt freq tightSCF"
    else
        keyword=trim(c200tmp)//" opt freq"
    end if
    if (ilevel==22.and.idiffuse==0) keyword=trim(keyword)//" def2-SVP/C" !RI-TDDFT opt must use /C
else if (itask==5) then !optTS
    if (index(c200tmp,"tightSCF")==0) then
        keyword=trim(c200tmp)//" optTS freq tightSCF"
    else
        keyword=trim(c200tmp)//" optTS freq"
    end if
    if (ilevel==22.and.idiffuse==0) keyword=trim(keyword)//" def2-SVP/C" !RI-TDDFT opt must use /C
else if (itask==8) then !NMR
    if (index(c200tmp,"tightSCF")==0) then
        keyword=trim(c200tmp)//" NMR tightSCF"
    else
        keyword=trim(c200tmp)//" NMR"
    end if
else
    keyword=trim(c200tmp)
end if
keyword=trim(keyword)//" noautostart miniprint nopop"

if (loadcharge==-99) then !Not loaded from input file
    netcharge=nint(sum(a%charge)-nelec)
    if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
else
    netcharge=loadcharge
end if
if (loadmulti==-99) then !Not loaded from input file
    multi=nint(naelec-nbelec)+1
else
    multi=loadmulti
end if

open(ifileid,file=outname,status="replace")

!Counterpoise task is a special case. Directly write input file and return
if (itask==7) then
    write(ifileid,"('%pal nprocs',i4,' end')") nprocs
    write(ifileid,"(/,a)") trim(keyword)
    if (ilevel==1006.or.ilevel==1007) call ORCA_DFT_D3_parm(ifileid)
    write(ifileid,"(a,i6)") "%maxcore",maxcore
    write(ifileid,"('* xyz',2i4)") netcharge,multi
    do i=1,ncenter
	    write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
    end do
    write(ifileid,*) "*"
    do itime=1,2
        write(ifileid,"(/,a)") "$new_job"
        write(ifileid,"(a)") trim(keyword)//" Pmodel" !Use Pmodel to regenerate new initial guess rather than use the previous wavefunction
        if (ilevel==1006.or.ilevel==1007) call ORCA_DFT_D3_parm(ifileid)
        write(ifileid,"(a,i6)") "%maxcore",maxcore
        write(ifileid,"('* xyz',2i4)") netcharge,multi
        do i=1,ncenter
	        if ((itime==1.and.any(CPfrag2==i)).or.(itime==2.and.any(CPfrag1==i))) then
                write(ifileid,"(a,':',1x,3f14.8)") trim(a(i)%name),a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
            else
                write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
            end if
        end do
        write(ifileid,*) "*"
    end do
    close(ifileid)
    write(*,"(a)") " Exporting ORCA input file finished!"
    write(*,"(a)") " If you run it, single point task will be carried out three times, and correspondingly, the ""FINAL SINGLE POINT ENERGY"" &
    data will be printed three times (EAB, EA and EB in turn), the interaction energy after counterpoise correction should be &
    manually calculated as EAB-EA-EB. In addition, please check charge and spin multiplicity to ensure that the setting is appropriate"
    return
end if

!Start to write input file for normal cases
write(ifileid,"(a)") trim(keyword)
write(ifileid,"(a,i6)") "%maxcore",maxcore
write(ifileid,"('%pal nprocs',i4,' end')") nprocs
!Write solvation model information
if (isolv==2.and.solvname/="custom") then
    write(ifileid,"(a)")"! CPCM("//trim(solvname)//")"
else if (isolv>0) then
    write(ifileid,"(a)") "%cpcm"
    if (isolv==1) then
        write(ifileid,"(a)") "smd true"
        write(ifileid,"(a)") 'SMDsolvent "'//trim(solvname)//'"'
    else if (isolv==2) then
        write(ifileid,"(a,f8.2)") "epsilon",diecons
        write(ifileid,"(a,f8.2)") "refrac",refrac
    end if
    write(ifileid,"(a)") "end"
end if

!Write additional D3 parameter
if (ilevel==1006.or.ilevel==1007) call ORCA_DFT_D3_parm(ifileid)

!Write task specific information
if (itask==5) then !Calculate Hessian for optTS
    write(ifileid,"(a)") "%geom Calc_Hess true end"
else if (itask==6) then !MD
    write(ifileid,"(a)") "%md"
    write(ifileid,"(a)") "#restart ifexists  # Continue MD by reading [basename].mdrestart if it exists. In this case ""initvel"" should be commented"
    write(ifileid,"(a)") "#minimize  # Do minimization prior to MD simulation"
    write(ifileid,"(a)") " timestep 0.5_fs  # This stepsize is safe at several hundreds of Kelvin"
    write(ifileid,"(a)") " initvel 100_K no_overwrite # Assign velocity according to temperature for atoms whose velocities are not available"
    if (iORCAver==0) then
        write(ifileid,"(a)") " thermostat berendsen 298.15_K timecon 30.0_fs  # Target temperature and coupling time constant"
    else if (iORCAver==1) then
        write(ifileid,"(a)") " thermostat CSVR 298.15_K timecon 30.0_fs  # Target temperature and coupling time constant"
    end if
    write(ifileid,"(a)") " dump position stride 1 format xyz filename ""pos.xyz""  # Dump position every ""stride"" steps"
    write(ifileid,"(a)") "#dump force stride 1 format xyz filename ""force.xyz""  # Dump force every ""stride"" steps"
    write(ifileid,"(a)") "#dump velocity stride 1 format xyz filename ""vel.xyz""  # Dump velocity every ""stride"" steps"
    write(ifileid,"(a)") "#dump gbw stride 20 filename ""wfn""  # Dump wavefunction to ""wfn[step].gbw"" files every ""stride"" steps"
    write(c80tmp,*) ncenter-1
    if (iORCAver==0) then
        write(ifileid,"(a)") " constraint add center 0.."//trim(adjustl(c80tmp))//"  # Fix center of mass at initial position"
        write(ifileid,"(a)") " run 2000  # Number of MD steps"
    else if (iORCAver==1) then
        write(ifileid,"(a)") " run 2000 CenterCOM # Number of MD steps. Remove motion of center of mass"
    end if
    write(ifileid,"(a)") "end"
end if
if (ilevel==20) then
    write(ifileid,"(a)") "%tddft"
    write(ifileid,"(a)") "Mode sTDDFT"
    write(ifileid,"(a)") "Ethresh 7.0"
    write(ifileid,"(a)") "PThresh 1e-4"
    write(ifileid,"(a)") "PTLimit 30"
    write(ifileid,"(a)") "triplets false" !When "triplets true", more excited states will be calculated
    write(ifileid,"(a)") "maxcore 6000" !sTDDFT only support serial mode, therefore more memory could be assigned
    write(ifileid,"(a)") "end"
else if (ilevel==21) then
    write(ifileid,"(a)") "%tddft"
    write(ifileid,"(a)") "nroots 10"
    write(ifileid,"(a)") "mode riints_disk"
    write(ifileid,"(a)") "end"
else if (ilevel==22.or.ilevel==23.or.ilevel==231) then
    write(ifileid,"(a)") "%tddft"
    write(ifileid,"(a)") "nroots 10"
    write(ifileid,"(a)") "TDA false"
    write(ifileid,"(a)") "end"
else if (ilevel==24.or.ilevel==25) then
    write(ifileid,"(a)") "%mdci"
    write(ifileid,"(a)") "nroots 3"
    write(ifileid,"(a)") "end"
end if

!Set frozen
if ((itask==2.or.itask==4.or.itask==5).and.(nfrozenatm>0.or.ioptHonly==1)) then
    write(ifileid,"(a)") "%geom"
    if (ioptHonly==0) then
        write(ifileid,"(a)") "  Constraints"
        do ifr=1,nfrozenatm
            write(ifileid,"('  { C',i7,' C }')") frozenatm(ifr)-1
        end do
        write(ifileid,"(a)") "  end"
    else
        write(ifileid,"(a)") "  optimizeHydrogens true"
    end if
    write(ifileid,"(a)") "end"
end if
!Wavefunction stability test, external field
if (itask==9.or.any(efield/=0)) then
    write(ifileid,"(a)") "%scf"
    if (itask==9) then
        write(ifileid,"(a)") "  STABPerform true"
        write(ifileid,"(a)") "  STABRestartUHFifUnstable true"
    end if
    if (any(efield/=0)) write(ifileid,"('  efield',f10.6,',',f10.6,',',f10.6)") efield(1),efield(2),efield(3)
    write(ifileid,"(a)") "end"
end if

!Write geometry
write(ifileid,"('* xyz',2i4)") netcharge,multi
do i=1,ncenter
	write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,*) "*"
close(ifileid)
write(*,"(a)") " ORCA input file has been exported to "//trim(outname)//", You should properly check it and modify keywords"
end subroutine

!Write external DFT-D3(BJ) parameter for wB97X-2
subroutine ORCA_DFT_D3_parm(ifileid)
integer ifileid
write(ifileid,"(a)") "# DFT-D3(BJ) parameter for wB97X-2, see SI of PCCP, 20, 23175 (2018)"
write(ifileid,"(a)") "%method"
write(ifileid,"(a)") "D3S6 0.547"
write(ifileid,"(a)") "D3A1 3.520"
write(ifileid,"(a)") "D3S8 0.0"
write(ifileid,"(a)") "D3A2 7.795"
write(ifileid,"(a)") "end"
end subroutine

!!---------- Output current coordinate to NWChem input file
subroutine outNWCheminp(outname,ifileid)
use defvar
character(len=*) outname
open(ifileid,file=outname,status="replace")
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
write(ifileid,"(a,i3)") "charge",netcharge
write(ifileid,"(a)") "GEOMETRY"
do i=1,ncenter
	write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,"(a)") "END"
write(ifileid,"(a)") "BASIS"
write(ifileid,"(a)") "* library 6-31G*"
write(ifileid,"(a)") "END"
write(ifileid,"(a)") "DFT"
write(ifileid,"(a)") "XC B3LYP"
write(ifileid,"(a,i3)") "mult",nint(naelec-nbelec)+1
write(ifileid,"(a)") "END"
write(ifileid,"(a)") "TASK DFT ENERGY"
close(ifileid)
write(*,"(a)") " Exporting NWChem input file finished! It corresponds to single point task at B3LYP/6-31G* level"
end subroutine

!!---------- Interface of outputting MOPAC input file
subroutine outMOPACinp_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for generating MOPAC input file, e.g. C:\ltwd.mop"
write(*,"(a)") " If press ENTER button directly, will be exported to "//trim(c200tmp)//".mop"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".mop"
call outMOPACinp(outname,10)
end subroutine
!!---------- Output current coordinate to MOPAC input file
subroutine outMOPACinp(outname,ifileid)
use defvar
use util
character(len=*) outname
character multistr*80,chargestr*10,c80tmp*80,c2000tmp*2000,keyword*80
integer :: itask=2,isolv=0,ifopt(ncenter),frozenatm(ncenter),iMOZYME=0
real*8 :: eps
write(*,"(a)") " Note: You can select an option with positive index to generate input file with corresponding level, &
other options can be used to change various calculation setting"

ifopt(:)=1
do while(.true.)
    write(*,*)
    if (itask==2) write(*,"(a,', current:',i6' atoms')") " -3 Set atom freeze in optimization",count(ifopt==0)
    if (iMOZYME==0) write(*,*) "-2 Toggle employing MOZYME to accelerate calculation, current: No"
    if (iMOZYME==1) write(*,*) "-2 Toggle employing MOZYME to accelerate calculation, current: Yes"
    if (isolv==1) write(*,"(a,f8.2)") " -1 Toggle employing COSMO solvation model, current: Yes, eps=",eps
    if (isolv==0) write(*,*) "-1 Toggle employing COSMO solvation model, current: No"
    if (itask==1) write(*,*) " 0 Select task, current: Single point"
    if (itask==2) write(*,*) " 0 Select task, current: Optimizing minimum"
    if (itask==3) write(*,*) " 0 Select task, current: Frequency analysis"
    write(*,*) " 1 PM6"
    write(*,*) " 2 PM6-DH+"
    write(*,*) " 3 PM6-D3H4"
    write(*,*) " 4 PM7"
    read(*,*) isel

    if (isel>0) then
        exit
    else if (isel==0) then
        write(*,*) "1 Single point"
        write(*,*) "2 Optimizing minimum"
        write(*,*) "3 Frequency analysis"
        read(*,*) itask
    else if (isel==-1) then
        if (isolv==0) then
            write(*,*) "Input dielectric constant, e.g. 60.2"
            write(*,"(a)") " Note: If you press ENTER button directly, water (eps=78.3553) will be employed as solvent"
            read(*,"(a)") c80tmp
            if (c80tmp==" ") then
                eps=78.3553
            else
                read(c80tmp,*) eps
            end if
            isolv=1
        else
            isolv=0
        end if
    else if (isel==-2) then
        if (iMOZYME==0) then
            iMOZYME=1
        else
            iMOZYME=0
        end if
    else if (isel==-3) then
        write(*,*) "Input the atoms to be frozen during optimization, e.g. 3,5-10,13,15"
        read(*,"(a)") c2000tmp
        call str2arr(c2000tmp,ntmp,frozenatm)
        ifopt(frozenatm(1:ntmp))=0
    end if
end do

open(ifileid,file=outname,status="replace")

if (isel==1) keyword="PM6"
if (isel==2) keyword="PM6-DH+"
if (isel==3) keyword="PM6-D3H4"
if (isel==4) keyword="PM7"
if (iMOZYME==1) keyword=trim(keyword)//" MOZYME"

if (itask==1) then
    ifopt=0
else if (itask==2) then
    keyword=trim(keyword)//" PRNT=2"
else if (itask==3) then
    keyword=trim(keyword)//" FORCE LET"
end if

if (isolv==1) then
    write(c80tmp,"(f12.4)") eps
    keyword=trim(keyword)//" eps="//adjustl(trim(c80tmp))
end if

netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
write(chargestr,"(i4)") netcharge
chargestr=adjustl(chargestr)
multival=nint(naelec-nbelec)+1

if (multival==1) then
	keyword=trim(keyword)//" precise charge="//trim(chargestr)
else
	if (multival==2) multistr="doublet"
	if (multival==3) multistr="triplet"
	if (multival==4) multistr="quartet"
	if (multival==5) multistr="quintet"
	if (multival==6) multistr="sextet"
    keyword=trim(keyword)//" precise UHF charge="//trim(chargestr)//' '//multistr
end if

write(ifileid,"(a)") trim(keyword)
write(ifileid,"(a)") "molecule"
write(ifileid,"(a)") "All coordinates are Cartesian"

do i=1,ncenter
	write(ifileid,"(a,1x,f14.8,i2,f14.8,i2,f14.8,i2)") a(i)%name,a(i)%x*b2a,ifopt(i),a(i)%y*b2a,ifopt(i),a(i)%z*b2a,ifopt(i)
end do

close(ifileid)
write(*,*) "Exporting MOPAC input file finished!"
end subroutine

!!---------- Interface of outputting PSI4 input file
subroutine outPSI4inp_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,"(/,a)") " Note: If you benefit from this function when creating PSI4 input file, please cite Multiwfn original paper, thanks!"
write(*,*)
write(*,*) "Input path for generating PSI4 input file, e.g. C:\ltwd.inp"
write(*,"(a)") " If press ENTER button directly, will be exported to "//trim(c200tmp)//".inp"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".inp"
call outPSI4inp(outname,10)
end subroutine
!!---------- Output current coordinate to PSI4 input file
subroutine outPSI4inp(outname,ifileid)
use defvar
use util
character(len=*) outname
integer ifileid,atmlist1(ncenter),atmlist2(ncenter),ioutfch
character c200tmp*200,c2000tmp*2000,taskstr*80,methodstr*20
ioutfch=0
write(*,*)
write(*,*) "-1 Generate input file using a template input file"
write(*,*) "0 Return"
write(*,*) "1 Intermolecular SAPT energy decomposition task"
write(*,*) "2 Single point energy or excitation energy task"
write(*,*) "3 Optimization task"
read(*,*) isel
if (isel==0) return

open(ifileid,file=outname,status="replace")

if (isel==-1) then !Special case
    write(*,*) "Input the path of the template file, e.g. C:\Sob\love\nico.inp"
    write(*,"(a)") " This file should contain everything of final input file, but the geometry part &
    should be denoted as [geometry], which will be automatically replaced by current coordinate"
    do while(.true.)
        read(*,"(a)") c200tmp
	    inquire(file=c200tmp,exist=alive)
	    if (alive) exit
	    write(*,*) "Cannot find the file, input again!"
    end do
    open(ifileid+1,file=c200tmp,status="old")
    do while(.true.)
        read(ifileid+1,"(a)",iostat=ierror) c200tmp
        if (ierror/=0) exit
        if (index(c200tmp,"[geometry]")/=0) then
            do iatm=1,ncenter
	            write(ifileid,"(a,1x,3f14.8)") a(iatm)%name,a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
            end do
        else
            write(ifileid,"(a)") trim(c200tmp)
        end if
    end do
    close(ifileid)
    close(ifileid+1)
    write(*,"(a)") " Done! The file has been exported to "//trim(outname)
    return
end if

write(ifileid,"('memory 4 GB')")
if (isel==1) then
    write(*,*) "1 Bronze (sSAPT0/jun-cc-pVDZ)"
    write(*,*) "2 Silver (SAPT2+/aug-cc-pVDZ)"
    write(*,*) "3 Gold (SAPT2+(3)dMP2/aug-cc-pVTZ)"
    write(*,*) "10 SAPT0/aug-cc-pVDZ with explicit charge-transfer energy"
    write(*,*) "11 SAPT2+(3)/aug-cc-pVTZ with explicit charge-transfer energy"
    read(*,*) isel2

    write(*,*) "Input indices of the atoms in fragment 1, e.g. 3,8-15,20 "
    read(*,"(a)") c2000tmp
    call str2arr(c2000tmp,nlist1,atmlist1)
    write(*,*) "Input indices of the atoms in fragment 2, e.g. 3,8-15,20 "
    read(*,"(a)") c2000tmp
    call str2arr(c2000tmp,nlist2,atmlist2)

    write(ifileid,"(a)")
    write(ifileid,"(a)") "molecule dimer {"
    write(ifileid,"(a)") "0 1"
    do idx=1,nlist1
        iatm=atmlist1(idx)
	    write(ifileid,"(a,1x,3f14.8)") a(iatm)%name,a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
    end do
    write(ifileid,"(a)") "--"
    write(ifileid,"(a)") "0 1"
    do idx=1,nlist2
        iatm=atmlist2(idx)
	    write(ifileid,"(a,1x,3f14.8)") a(iatm)%name,a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
    end do
    write(ifileid,"(a)") "}"
    write(ifileid,"(a)")
    write(ifileid,"(a)") "set {"
    write(ifileid,"(a)") "    scf_type DF"
    write(ifileid,"(a)") "    freeze_core True"
    if (isel2==1) write(ifileid,"(a)") "    basis jun-cc-pVDZ"
    if (isel2==2) write(ifileid,"(a)") "    basis aug-cc-pVDZ"
    if (isel2==3) write(ifileid,"(a)") "    basis aug-cc-pVTZ"
    if (isel2==10) write(ifileid,"(a)") "    basis aug-cc-pVDZ"
    if (isel2==11) write(ifileid,"(a)") "    basis aug-cc-pVTZ"
    write(ifileid,"(a)") "}"
    write(ifileid,"(a)")
    if (isel2==1) write(ifileid,"(a)") "energy('sapt0')"
    if (isel2==2) write(ifileid,"(a)") "energy('sapt2+')"
    if (isel2==3) write(ifileid,"(a)") "energy('sapt2+(3)dmp2')"
    if (isel2==10) write(ifileid,"(a)") "energy('sapt0-ct')"
    if (isel2==11) write(ifileid,"(a)") "energy('sapt2+(3)-ct')"
    write(*,"(a)") " Exporting PSI4 input file finished! Note that charge of spin multiplicity &
    of the fragments are assumed to be 0 and 1, respectively"

else if (isel==2.or.isel==3) then !Single point, optimization
    !Note: At least for PSI 1.3.2, only DF-CCSD(T) gradient can use frozen core
    do while(.true.)
        write(*,*)
        if (isel==2) then
            if (ioutfch==0) write(*,*) "-1 Toggle outputting .fch file, current: No"
            if (ioutfch==1) write(*,*) "-1 Toggle outputting .fch file, current: Yes"
        end if
        write(*,*) "                         Select a calculation level:"
        if (isel==2) then !SP
            write(*,*) " 1 BLYP-D3(BJ)/def2-SVP with density fitting"
            write(*,*) " 2 B3LYP-D3(BJ)/def2-SVP with density fitting"
            write(*,*) " 3 PBEh-3c with density fitting"
            write(*,*) " 4 M06-2X/def2-TZVP with density fitting"
            write(*,*) " 5 PWPB95-D3(BJ)/cc-pVTZ with density fitting and frozen core"
            write(*,*) " 9 MP2/cc-pVTZ with density fitting and frozen core"
            write(*,*) "10 CCSD(T)/cc-pVTZ with frozen core"
            write(*,*) "11 CCSD(T)/cc-pVTZ with density fitting and frozen core"
            write(*,*) "12 Full-CI/cc-pVDZ"
            write(*,*) "19 ADC(2)/cc-pVTZ with frozen core"
            write(*,*) "20 EOM-CC2/cc-pVTZ with frozen core"
            write(*,*) "21 EOM-CCSD/cc-pVTZ with frozen core"
            write(*,*) "22 EOM-CC3/cc-pVTZ with frozen core"
        else if (isel==3) then !opt
            write(*,*) " 1 BLYP-D3(BJ)/def2-SVP with density fitting"
            write(*,*) " 2 B3LYP-D3(BJ)/def2-SVP with density fitting"
            write(*,*) " 3 PBEh-3c with density fitting"
            write(*,*) " 4 M06-2X/def2-TZVP with density fitting"
            write(*,*) " 5 PWPB95-D3(BJ)/cc-pVTZ with density fitting and frozen core (Numer. grad.)"
            write(*,*) " 9 MP2/cc-pVTZ with density fitting and frozen core"
            write(*,*) "10 CCSD(T)/cc-pVTZ without frozen core"
            write(*,*) "11 CCSD(T)/cc-pVTZ with density fitting and frozen core"
            write(*,*) "12 Full-CI/cc-pVDZ (Numerical gradient)"
            !write(*,*) "19 ADC(2)/cc-pVTZ with frozen core" !opt has not been supported, even numerical gradient
            write(*,*) "20 EOM-CC2/cc-pVTZ with frozen core (Numer. grad.)"
            write(*,*) "21 EOM-CCSD/cc-pVTZ" !EOM-CCSD gradient doesn't support frozen core
            write(*,*) "22 EOM-CC3/cc-pVTZ with frozen core (Numer. grad.)"
        end if
        read(*,*) isel2
        if (isel2==-1) then
            if (ioutfch==0) then
                ioutfch=1
            else
                ioutfch=0
            end if
        else
            exit
        end if
    end do

    netcharge=nint(sum(a%charge)-nelec)
    if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
    multi=nint(naelec-nbelec)+1

    !Write molecular geometry
    write(ifileid,"(a)") "molecule mol {"
    write(ifileid,"(2i4)") netcharge,multi
    do iatm=1,ncenter
	    write(ifileid,"(a,1x,3f14.8)") a(iatm)%name,a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
    end do
    if (isel2==20.or.isel2==21.or.isel==22) write(ifileid,"(a)") "symmetry c1" !For EOM- calculation, assumed to be nosymm
    write(ifileid,"(a)") "}"

    !Set basis set and various settings
    write(ifileid,*)
    write(ifileid,"(a)") "set {"
    if (isel2==1.or.isel2==2) then
        write(ifileid,"(2x,a)") "basis def2-SVP"
    else if (isel2==4) then
        write(ifileid,"(2x,a)") "basis def2-TZVP"
    else if (isel2==5.or.isel2==9) then
        write(ifileid,"(2x,a)") "basis cc-pVTZ"
        write(ifileid,"(2x,a)") "freeze_core true"
        write(ifileid,"(2x,a)") "scf_type df"
    else if (isel2==10.or.isel2==11) then
        write(ifileid,"(2x,a)") "basis cc-pVTZ"
        if (.not.(isel==3.and.isel2==10)) write(ifileid,"(2x,a)") "freeze_core true" !Regular CCSD(T) cannot use FC
        if (isel2==11) then
            write(ifileid,"(2x,a)") "scf_type df"
            write(ifileid,"(2x,a)") "cc_type df"
        end if
    else if (isel2==12) then
        write(ifileid,"(2x,a)") "basis cc-pVDZ"
        write(ifileid,"(2x,a)") "#NUM_ROOTS 3"
    else if (isel2==20.or.isel2==21.or.isel2==22) then
        write(ifileid,"(2x,a)") "basis cc-pVTZ"
        if (.not.(isel==3.and.isel2==21)) write(ifileid,"(2x,a)") "freeze_core true"
        write(ifileid,"(2x,a)") "ROOTS_PER_IRREP [3]"
    end if
    if (multi>1) write(ifileid,"(2x,a)") "reference uhf"
    write(ifileid,"(a)") "}"

    !Method
    write(ifileid,*)
    if (isel==2) taskstr="energy"
    if (isel==3) taskstr="opt"
    if (isel2==1) then
        methodstr="blyp-d3bj"
    else if (isel2==2) then
        methodstr="b3lyp-d3bj"
    else if (isel2==3) then
        methodstr="pbeh3c"
    else if (isel2==4) then
        methodstr="m06-2x"
    else if (isel2==5) then
        methodstr="pwpb95-d3bj"
    else if (isel2==9) then
        methodstr="mp2"
    else if (isel2==10.or.isel2==11) then
        methodstr="ccsd(t)"
    else if (isel2==12) then
        methodstr="fci"
    else if (isel2==20) then
        methodstr="eom-cc2"
    else if (isel2==21) then
        methodstr="eom-ccsd"
    else if (isel2==22) then
        methodstr="eom-cc3"
    end if
    if (ioutfch==0) then
        write(ifileid,"(a)") trim(taskstr)//"('"//trim(methodstr)//"')"
    else if (ioutfch==1) then
        if (isel2<5) then
            write(ifileid,"(a)") "energy, wfn = "//trim(taskstr)//"('"//trim(methodstr)//"', return_wfn=True)"
        else
            write(ifileid,"(a)") "grad, wfn = gradient"//"('"//trim(methodstr)//"', return_wfn=True)"
        end if
        write(ifileid,"(a)") "fchk_writer = psi4.FCHKWriter(wfn)"
        itmp=index(outname,'.',back=.true.)
        if (itmp==0) itmp=len_trim(outname)+1
        write(ifileid,"(a)") "fchk_writer.write('"//outname(:itmp-1)//".fch')"
    end if
    write(*,"(a)") " Exporting PSI4 input file finished!"
end if

close(ifileid)
end subroutine

!!---------- Output current coordinate to MRCC input file
subroutine outMRCCinp(outname,ifileid)
use defvar
character(len=*) outname
open(ifileid,file=outname,status="replace")
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
write(ifileid,"(a)") "basis=cc-pVDZ"
write(ifileid,"(a)") "calc=CCSDT(Q)"
write(ifileid,"(a,i2)") "charge=",netcharge
write(ifileid,"(a,i2)") "multi=",nint(naelec-nbelec)+1
write(ifileid,"(a)") "mem=2500MB"
write(ifileid,*)
write(ifileid,"(a)") "geom=xyz"
write(ifileid,"(i5)") ncenter
write(ifileid,*)
do i=1,ncenter
	write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
close(ifileid)
write(*,"(a)") " Exporting MRCC input file finished! The file is named ""MINP"" in current folder. It corresponds to single point task at CCSDT(Q)/cc-pVDZ level"
end subroutine

!!---------- Output current coordinate to CFOUR input file
subroutine outCFOURinp(outname,ifileid)
use defvar
character(len=*) outname
open(ifileid,file=outname,status="replace")
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
write(ifileid,"(a)") "mol"
do i=1,ncenter
	write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,*)
write(ifileid,"(a,i3)") "CHARGE=",netcharge
write(ifileid,"(a,i3)") "MULTIPLICITY=",nint(naelec-nbelec)+1
write(ifileid,"(a)") "FROZEN_CORE=ON"
write(ifileid,"(a)") "*CFOUR(CALC=CCSD(T),BASIS=cc-pVTZ,COORD=CARTESIAN,CC_PROG=NCC,ABCDTYPE=AOBASIS)"
write(ifileid,*)
close(ifileid)
write(*,"(a)") " Exporting CFOUR input file finished! The file is named ""ZMAT"" in current folder. It corresponds to single point task at CCSD(T,FC)/cc-pVTZ level"
end subroutine

!!---------- Output current coordinate to Molpro input file
subroutine outMolproinp(outname,ifileid)
use defvar
character(len=*) outname
open(ifileid,file=outname,status="replace")
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
write(ifileid,"(a)") "angstrom"
write(ifileid,"(a)") "geometry={"
do i=1,ncenter
	write(ifileid,"(a,',,',f14.8,',',f14.8,',',f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,"(a)") "}"
write(ifileid,"(a)") "basis=vtz"
write(ifileid,"(a)") "{hf"
write(ifileid,"(a,i2,a,i2)") "wf, charge=",netcharge,", spin=",nint(naelec-nbelec)
write(ifileid,"(a)") "}"
write(ifileid,"(a)") "ccsd(T)"
close(ifileid)
write(*,"(a)") " Exporting Molpro input file finished! It corresponds to single point task at CCSD(T)/cc-pVTZ level"
end subroutine

!!---------- Output current coordinate to Molcas input file
subroutine outmolcasinp(outname,ifileid)
use defvar
character(len=*) outname
open(ifileid,file=outname,status="replace")
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
write(ifileid,"(a)") "&GATEWAY"
write(ifileid,"(a)") "Coord"
write(ifileid,"(i5)") ncenter
write(ifileid,"(a)") "Generated by Multiwfn"
do i=1,ncenter
	write(ifileid,"(a,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,"(a)") "basis=cc-pVDZ"
write(ifileid,"(a)") "&SEWARD"
write(ifileid,"(a)") "&SCF"
if (naelec==nbelec) then
	write(ifileid,"(a)") "ksdft=b3lyp"
else
	write(ifileid,"(a)") "uhf;ksdft=b3lyp"
end if
write(ifileid,"(a,i3)") "charge=",netcharge
write(ifileid,"(a,i3)") "zspin=",nint(naelec-nbelec)
close(ifileid)
write(*,"(a)") " Exporting Molcas input file finished! It corresponds to single point task at B3LYP/cc-pVDZ level"
end subroutine

!!---------- Output current coordinate to Q-Chem input file
subroutine outQcheminp(outname,ifileid)
use defvar
character(len=*) outname
open(ifileid,file=outname,status="replace")
netcharge=nint(sum(a%charge)-nelec)
multi=nint(naelec-nbelec)+1
write(ifileid,"(a)") "$molecule"
write(ifileid,"(2i4)") netcharge,multi
do i=1,ncenter
	write(ifileid,"(a,1x,3f14.8)") a(i)%name,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,"(a)") "$end"
write(ifileid,*)
write(ifileid,"(a)") "$rem"
write(ifileid,"(a)") "GUI 2    !Generate .fch file"
write(ifileid,"(a)") "EXCHANGE B3LYP"
write(ifileid,"(a)") "BASIS 6-31G*"
write(ifileid,"(a)") "DFT_D D3_BJ"
write(ifileid,"(a)") "$end"
close(ifileid)
write(*,"(a)") " Exporting Q-Chem input file finished! It corresponds to single point task at B3LYP-D3(BJ)/6-31G* level"
end subroutine

!!---------- Output current coordinate to Dalton input file (.dal and .mol)
!When symmetry is used, the number of atomtypes may not be consistent with the number of elements, such as O3.
!Therefore, for simplicity, we do not use symmetry (i.e. Nosymmetry), and thus assign atomtypes as the number of elements
!Spin multiplicity is not set in .dal, because the rule in Dalton is quite complicated
subroutine outDaltoninp(dalname,molname,ifileid)
use defvar
character(len=*) dalname,molname
character tmpstr*5,c20tmp*20,c20tmp2*20
netcharge=nint(sum(a%charge)-nelec)
if (nelec==0) netcharge=0 !nelec==0 means no electron informations, e.g. pdb file
if (dalname/=" ") then
	open(ifileid,file=dalname,status="replace")
	write(ifileid,"(a)") "**DALTON INPUT"
	write(ifileid,"(a)") ".RUN WAVE FUNCTIONS"
	write(ifileid,"(a)") "**WAVE FUNCTIONS"
	write(ifileid,"(a)") ".DFT"
	write(ifileid,"(a)") " B3LYPg"
	write(ifileid,"(a)") "**END OF INPUT"
	close(ifileid)
end if

open(ifileid,file=molname,status="replace")
write(ifileid,"(a)") "ATOMBASIS"
write(ifileid,"(a)") "test molecule"
write(ifileid,"(a)") "Generated by Multiwfn"
natmtype=0
do iele=1,nelesupp
	if (any(a%index==iele)) natmtype=natmtype+1
end do
write(c20tmp,"(i5)") natmtype
c20tmp=adjustl(c20tmp)
write(c20tmp2,"(i5)") netcharge
c20tmp2=adjustl(c20tmp2)
write(ifileid,"(a,a,a,a)") "Atomtypes=",trim(c20tmp)," Angstrom Nosymmetry charge=",trim(c20tmp2)
do iele=1,nelesupp
	natmthis=count(a%index==iele)
	if (natmthis>0) then
		write(c20tmp,"(f4.1)") dfloat(iele)
		c20tmp=adjustl(c20tmp)
		write(c20tmp2,"(i5)") natmthis
		c20tmp2=adjustl(c20tmp2)
		write(ifileid,"(a,a,a,a,a)") "Charge=",trim(c20tmp)," Atoms=",trim(c20tmp2)," Basis=6-31G*"
		itmp=0
		do iatm=1,ncenter
			if (a(iatm)%index/=iele) cycle
			itmp=itmp+1
			write(tmpstr,"(i5)") itmp
			tmpstr=adjustl(tmpstr)
			write(ifileid,"(a,3f14.8)") trim(a(iatm)%name)//trim(tmpstr),a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
		end do
	end if
end do
close(ifileid)
write(*,"(a)") " Exporting Dalton input file finished! It corresponds to single point task at B3LYPg/6-31G* level"
if (naelec/=nbelec) write(*,*) "Electronic configuration in .dal file should be manually set properly"
end subroutine

!!---------- Interface of outputting CP2K input file
subroutine outCP2Kinp_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,"(/,a)") " Note: Please mention Multiwfn and cite original paper of Multiwfn if you benefits from this function in your study, thank you!"
write(*,*)
write(*,*) "Input path for generating CP2K input file, e.g. C:\ltwd.inp"
write(*,"(a)") " If press ENTER button directly, will export to "//trim(c200tmp)//".inp"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".inp"
call outCP2Kinp(outname,10)
end subroutine
!!---------- Output current coordinate to CP2K input file
!TODO: Support BSSE, BAND, TDDFTPT
subroutine outCP2Kinp(outname,ifileid)
use defvar
use util
character(len=*) outname
integer :: ifileid,ibas=2,tmparr(ncenter)
character c80tmp*80,c80tmp2*80,c200tmp*200,c2000tmp*2000
character :: method*20="PBE",basname*30(-10:30)=" ",PBCdir*4="XYZ "
integer :: itask=1,idispcorr=0,imolden=0,ioutvibmol=1,ithermostat=0,ibarostat=0,iSCCS=0,idipcorr=0,iMP2=0,imoment=0,ioptmethod=1,iprintlevel=1
integer :: iMDformat=1,nMDsavefreq=1,ioutcube=0,idiagOT=1,imixing=2,ismear=0,iatomcharge=0,ifineXCgrid=0,iouterSCF=0,iDFTplusU=0
integer :: natmcons=0,nthermoatm=0,ikpoint1=1,ikpoint2=1,ikpoint3=1,nrep1=1,nrep2=1,nrep3=1
integer,allocatable :: atmcons(:),thermoatm(:)
real*8 :: efieldvec(3)=0

!Status information of current system. ",save" is used so that for the same system we can enter this interface multiple times to generate various input files
integer,save :: netchg,multispin
integer,allocatable,save :: atmkind(:) !The kind that atoms belonging to
integer,parameter :: nkindmax=200
integer,save :: nkind=0 !Current number of kinds
character,save :: kindname(nkindmax)*5 !Name of each kind
integer,save :: kindeleidx(nkindmax) !Element idx of each kind
integer,save :: kindmag(nkindmax) !Magnetization of each kind
character*200,save :: lastinpname !Input file of last time in this interface

rbuffer=5D0/b2a !10 Angstrom buffer size around isolated system, adequate even for QZ basis set
iconvtest=0
ikpconvtest=0
if (index(outname,"cutconv.inp")/=0) then
    iconvtest=1
    iprintlevel=2 !Medium printing level
    !ifineXCgrid=1 !I found this effectively often improves smoothness of convergence with respect to cutoff
    write(*,*) "Note: The generated file is dedicated to cutoff convergence testing purpose"
else if (index(outname,"kpconv.inp")/=0) then
    ikpconvtest=1
    write(*,*) "Note: The generated file is dedicated to k-point convergence testing purpose"
end if

!Conversion of basis set index to basis set name
basname(-1)="SZV-GTH"
basname(-2)="DZVP-GTH"
basname(-3)="TZVP-GTH"
basname(-4)="TZV2P-GTH"
basname(-5)="QZV2P-GTH"
basname(-6)="QZV3P-GTH"
basname(1)="SZV-MOLOPT-SR-GTH"
basname(2)="DZVP-MOLOPT-SR-GTH"
basname(3)="TZVP-MOLOPT-GTH"
basname(4)="TZV2P-MOLOPT-GTH"
basname(5)="TZV2PX-MOLOPT-GTH"
basname(10)="6-31G*"
basname(11)="6-311G**"
basname(12)="Ahlrichs-def2-TZVP"
basname(13)="pob-TZVP"
basname(14)="Ahlrichs-def2-QZVP"
basname(20)="cc-DZ with RI_DZ"
basname(21)="cc-TZ with RI_TZ"

!Construct kind information, charge and multiplicity
10 if (allocated(atmkind).and.filename/=lastinpname) deallocate(atmkind) !Has allocated last time, need to regenerate if the last system is different to the present one
if (.not.allocated(atmkind)) then !Haven't been constructed, namely first time use this function for present system, or this system it not identical to the last one
    write(*,*) "Generating KIND information..."
    allocate(atmkind(ncenter))
    !Build initial kind list
    nkind=1
    kindeleidx(1)=a(1)%index
    kindname(1)=a(1)%name
    do iatm=2,ncenter
        if (all(kindeleidx(:nkind)/=a(iatm)%index)) then
            nkind=nkind+1
            kindeleidx(nkind)=a(iatm)%index
            kindname(nkind)=a(iatm)%name
        end if
    end do
    !Assign each atom by a kind
    do iatm=1,ncenter
        do ikind=1,nkind
            if (a(iatm)%index==kindeleidx(ikind)) then
                atmkind(iatm)=ikind
                exit
            end if
        end do
    end do
    kindmag=0
    netchg=sum(a%charge)-nint(nelec)
    multispin=nint(naelec-nbelec)+1
    if (ifPBC==0) PBCdir="NONE"
    if (ncenter>300) ioptmethod=2 !LBFGS is more suitable for large system than BFGS
    lastinpname=filename
end if

do while(.true.)
    !do iatm=1,ncenter
    !    ikind=atmkind(iatm)
    !    write(*,"(' Atom',i6,1x,a,'  Kind index:',i3,'  Kind name: ',a,'  Kind elem idx:',i3)") iatm,a(iatm)%name,ikind,kindname(ikind),kindeleidx(ikind)
    !end do
    write(*,*)
    write(*,*) "-11 Enter the interface for geometry operations"
    write(*,*) "-10 Return"
    write(*,*) "-9 Other settings"
    write(*,*) "-7 Set direction(s) of applying periodic boundary condition, current: "//PBCdir
    if (itask==6) then
        write(*,"(a,i6)") " -6 Set frequency of writing molecular dynamics trajectory, current:",nMDsavefreq
        if (iMDformat==1) write(*,*) "-5 Choose molecular dynamics format, current: xyz"
        if (iMDformat==2) write(*,*) "-5 Choose molecular dynamics format, current: dcd"
        if (iMDformat==3) write(*,*) "-5 Choose molecular dynamics format, current: pdb"
    end if
    if (iatomcharge==0) write(*,*) "-4 Calculate atomic charges, current: None"
    if (iatomcharge==1) write(*,*) "-4 Calculate atomic charges, current: Mulliken"
    if (iatomcharge==2) write(*,*) "-4 Calculate atomic charges, current: Lowdin"
    if (iatomcharge==3) write(*,*) "-4 Calculate atomic charges, current: Hirshfeld"
    if (iatomcharge==4) write(*,*) "-4 Calculate atomic charges, current: Hirshfeld-I"
    if (iatomcharge==5) write(*,*) "-4 Calculate atomic charges, current: Voronoi"
    if (iatomcharge==6) write(*,*) "-4 Calculate atomic charges, current: RESP"
    if (iatomcharge==7) write(*,*) "-4 Calculate atomic charges, current: REPEAT"
    if (ioutcube==0) write(*,*) "-3 Set exporting cube file, current: None"
    if (ioutcube==1) write(*,*) "-3 Set exporting cube file, current: Electron density"
    if (ioutcube==2) write(*,*) "-3 Set exporting cube file, current: ELF"
    if (ioutcube==3) write(*,*) "-3 Set exporting cube file, current: XC potential"
    if (ioutcube==4) write(*,*) "-3 Set exporting cube file, current: Hartree potential (negative of ESP)"
    if (ioutcube==5) write(*,*) "-3 Set exporting cube file, current: Electric field"
    if (ioutcube==6) write(*,*) "-3 Set exporting cube file, current: Molecular orbital(s)"
    if (imolden==0) write(*,*) "-2 Toggle exporting .molden file for Multiwfn, current: No"
    if (imolden==1) write(*,*) "-2 Toggle exporting .molden file for Multiwfn, current: Yes"
    if (itask==1) write(*,*) "-1 Choose task, current: Energy"
    if (itask==2) write(*,*) "-1 Choose task, current: Energy + force"
    if (itask==3) write(*,*) "-1 Choose task, current: Optimizing structure"
    if (itask==4) write(*,*) "-1 Choose task, current: Optimizing structure and cell"
    if (itask==5) write(*,*) "-1 Choose task, current: Vibrational analysis"
    if (itask==6) write(*,*) "-1 Choose task, current: Molecular dynamics"
    if (itask==7) write(*,*) "-1 Choose task, current: Searching transition state"
    if (itask==8) write(*,*) "-1 Choose task, current: Nudge-elastic band"
    if (itask==9) write(*,*) "-1 Choose task, current: NMR"
    write(*,*) " 0 Generate input file now!"
    write(*,*) " 1 Choose theoretical method, current: "//trim(method)
    if (method/="GFN1-xTB".and.method/="PM6") write(*,*) " 2 Choose basis set and pseudopotential, current: "//trim(basname(ibas))
    if (method/="MP2".and.method/="GFN1-xTB".and.method/="PM6".and.method/="BEEFVDW") then
        if (idispcorr==0) write(*,*) " 3 Set dispersion correction, current: None"
        if (idispcorr==1) write(*,*) " 3 Set dispersion correction, current: DFT-D3"
        if (idispcorr==2) write(*,*) " 3 Set dispersion correction, current: DFT-D3(BJ)"
        if (idispcorr==5) write(*,*) " 3 Set dispersion correction, current: rVV10"
    end if
    if (idiagOT==1) then
        write(*,*) " 4 Switching between diagonalization and OT, current: Diagonalization"
        if (method/="PM6") then !I found PM6 can only use Direct mixing
            if (imixing==1) write(*,*) " 5 Set density matrix mixing, current: Direct mixing + DIIS"
            if (imixing==2) write(*,*) " 5 Set density matrix mixing, current: Broyden mixing"
            if (imixing==3) write(*,*) " 5 Set density matrix mixing, current: Pulay mixing"
        end if
        if (ismear==0) write(*,*) " 6 Toggle smearing electron occupation, current: No"
        if (ismear==1) write(*,*) " 6 Toggle smearing electron occupation, current: Yes"
    else if (idiagOT==2) then
        write(*,*) " 4 Switching between diagonalization and OT, current: OT"
        if (iouterSCF==0) write(*,*) " 5 Toggle using outer SCF process, current: No"
        if (iouterSCF==1) write(*,*) " 5 Toggle using outer SCF process, current: Yes"
    end if
    if (iSCCS==0) write(*,*) " 7 Toggle using self-consistent continuum solvation (SCCS), current: No"
    if (iSCCS==1) write(*,*) " 7 Toggle using self-consistent continuum solvation (SCCS), current: Yes"
    if (ikpoint1==1.and.ikpoint2==1.and.ikpoint3==1) then
        write(*,*) " 8 Set k-points, current: GAMMA only"
    else
        write(*,"(a,3i3)") "  8 Set k-points, current: MONKHORST-PACK",ikpoint1,ikpoint2,ikpoint3
    end if
    if (itask>=3.and.itask<=7) then
        if (natmcons==0) then
            write(*,*) " 9 Set atom position constraint, current: None"
        else
            write(*,"(a,i6)") "  9 Set atom position constraint, current:",natmcons
        end if
    end if
    !Task specific options
    if (itask==6) then
        if (ithermostat==0) write(*,*) "10 Set thermostat, current: None"
        if (ithermostat==1) write(*,*) "10 Set thermostat, current: Adaptive-Langevin"
        if (ithermostat==2) write(*,*) "10 Set thermostat, current: Canonical sampling through velocity rescaling"
        if (ithermostat==3) write(*,*) "10 Set thermostat, current: Generalized Langevin Equation (GLE)"
        if (ithermostat==4) write(*,*) "10 Set thermostat, current: Nose-Hoover"
        if (ithermostat>0) then
            if (nthermoatm==ncenter) then
                write(*,*) "11 Set region for the thermostat, current: All atoms"
            else
                write(*,"(a,i6,' atoms')") " 11 Set region for the thermostat, number of current atoms:",nthermoatm
            end if
        end if
        if (ibarostat==0) write(*,*) "12 Set barostat, current: None"
        if (ibarostat==1) write(*,*) "12 Set barostat, current: Yes, flexible cell"
        if (ibarostat==2) write(*,*) "12 Set barostat, current: Yes, isotropic cell"
    else if (itask==3.or.itask==4) then
        if (ioptmethod==1) write(*,*) "10 Set optimization method, current: BFGS"
        if (ioptmethod==2) write(*,*) "10 Set optimization method, current: LBFGS"
        if (ioptmethod==3) write(*,*) "10 Set optimization method, current: CG"
    else if (itask==5) then
        if (ioutvibmol==0) write(*,*) "10 Toggle exporting Molden file recording vibrational modes, current: No"
        if (ioutvibmol==1) write(*,*) "10 Toggle exporting Molden file recording vibrational modes, current: Yes"
    end if
    read(*,*) isel

    if (isel==-11) then
        natmold=ncenter
        call geom_operation
        !User may use geometry operation interface to reorder atoms or construct supercell, so we need to rebuild atom kind information
        if (any(a(1:size(a_org))%index/=a_org%index).or.ncenter/=natmold) then
            deallocate(atmkind)
            if (allocated(atmcons)) deallocate(atmcons)
            natmcons=0
            if (allocated(thermoatm)) deallocate(thermoatm)
            nthermoatm=0
            ithermostat=0
            goto 10
        end if
    else if (isel==-10) then
        return
    else if (isel==-9) then
        do while(.true.)
            write(*,*)
            write(*,*) "                     ---------- Other settings ----------"
            write(*,*) "0 Return"
            write(*,"(a,i5)") " 1 Set net charge, current:",netchg
            write(*,"(a,i3)") " 2 Set spin multiplicity, current:",multispin
            write(*,"(a,3i3)") " 3 Set number of repetitions of the cell in X, Y, Z, current:",nrep1,nrep2,nrep3
            if (ifineXCgrid==0) write(*,"(a)") " 4 Toggle using finer grid for exchange-correlation part, current: No"
            if (ifineXCgrid==1) write(*,"(a)") " 4 Toggle using finer grid for exchange-correlation part, current: Yes"
            if (idipcorr==0) write(*,*) "5 Set surface dipole correction, current: None"
            if (idipcorr==1) write(*,*) "5 Set surface dipole correction, current: X direction"
            if (idipcorr==2) write(*,*) "5 Set surface dipole correction, current: Y direction"
            if (idipcorr==3) write(*,*) "5 Set surface dipole correction, current: Z direction"
            if (imoment==0) write(*,*) "6 Print moments, current: No"
            if (imoment==1) write(*,*) "6 Print moments, current: Yes"
            if (ifPBC==0) write(*,"(a,f8.3,' Angstrom')") " 7 Set buffer distance for determining cell size, current:",rbuffer*b2a
            if (iDFTplusU==0) write(*,*) "8 Toggle using DFT+U, current: No"
            if (iDFTplusU==1) write(*,*) "8 Toggle using DFT+U, current: Yes"
            if (all(kindmag(1:nkind)==0)) then
                write(*,*) "9 Define atomic magnetization"
            else
                nmagset=count(kindmag(1:nkind)/=0)
                write(*,"(a,i3,a)") " 9 Redefine atomic magnetization, current: Manually defined",nmagset," kinds"
            end if
            if (iprintlevel==0) write(*,*) "10 Choose printing level of output information, current: Silent"
            if (iprintlevel==1) write(*,*) "10 Choose printing level of output information, current: Low"
            if (iprintlevel==2) write(*,*) "10 Choose printing level of output information, current: Medium"
            if (iprintlevel==3) write(*,*) "10 Choose printing level of output information, current: High"
            if (all(efieldvec==0)) then
                write(*,"(a)") " 11 Set electric field vector"
            else
                write(*,"(a,3f8.5,' a.u.')") " 11 Set electric field vector, current:",efieldvec
            end if
            read(*,*) isel2
            if (isel2==0) then
                exit
            else if (isel2==1) then
                write(*,*) "Input net charge, e.g. 1"
                read(*,*) netchg
            else if (isel2==2) then
                write(*,*) "Input spin multiplicity, e.g. 3"
                read(*,*) multispin
            else if (isel2==3) then
                write(*,*) "Input number of repetitions of the cell in X, Y, Z, e.g. 2,1,2"
                read(*,*) nrep1,nrep2,nrep3
            else if (isel2==4) then
                if (ifineXCgrid==0) then
                    ifineXCgrid=1
                else
                    ifineXCgrid=0
                end if
            else if (isel2==5) then
                write(*,*) "0 Do not use surface dipole correction"
                write(*,*) "1 Use surface dipole correction in X direction"
                write(*,*) "2 Use surface dipole correction in Y direction"
                write(*,*) "3 Use surface dipole correction in Z direction"
                read(*,*) idipcorr
            else if (isel2==6) then
                if (imoment==1) then
                    imoment=0
                else
                    imoment=1
                end if
            else if (isel2==7) then
                write(*,*) "Input buffer size around the system in Angstrom, e.g. 5.5"
                read(*,*) rbuffer
                rbuffer=rbuffer/b2a
            else if (isel2==8) then
                if (iDFTplusU==1) then
                    iDFTplusU=0
                else
                    iDFTplusU=1
                    write(*,"(a)") " IMPORTANT NOTE: DO NOT forget to manually replace the default DFT+U parameters in the generated input file with proper value!"
                end if
            else if (isel2==9) then
                !do ikind=1,nkind
                !    write(*,"(' #',i3,':  Kind name: ',a5,' Element: ',a,'  Magnetization:',i3,'   Natoms:',i5)") &
                !    ikind,kindname(ikind),ind2name(kindeleidx(ikind)),kindmag(ikind),count(atmkind(:)==ikind)
                !end do
                do while(.true.)
                    write(*,*)
                    write(*,*) "Current magnetization status:"
                    idx=0
                    do ikind=1,nkind
                        ncount=count(atmkind(:)==ikind)
                        if (ncount>0) then
                            idx=idx+1
                            write(*,"(' #',i3,':  Kind name: ',a5,' Element: ',a,'  Magnetization:',i3,'   Natoms:',i5)") &
                            idx,kindname(ikind),ind2name(kindeleidx(ikind)),kindmag(ikind),ncount
                        end if
                    end do
                    write(*,*)
                    write(*,*) "Input indices of the atoms to define magnetization, e.g. 1,5-10,13,19"
                    write(*,*) "To change kind name, input old and new name, e.g. Fe_1 Fe_B"
                    write(*,*) "To exit, inputting ""q"""
                    read(*,"(a)") c2000tmp
                    if (c2000tmp=="q") then
                        multispin=sum(kindmag(atmkind(:)))+1
                        exit
                    else if (iachar(c2000tmp(1:1))<48.or.iachar(c2000tmp(1:1))>57) then !The first character is not a number
                        read(c2000tmp,*) c80tmp,c80tmp2
                        do ikind=1,nkind
                            if (trim(kindname(ikind))==trim(c80tmp)) kindname(ikind)=trim(c80tmp2)
                        end do
                        cycle
                    end if
                    call str2arr(c2000tmp,ntmp,tmparr)
                    if (all(a(tmparr(1:ntmp))%index==a(tmparr(1))%index)) then
                        nkind=nkind+1
                        write(*,*) "Input magnetization (difference of alpha and beta electrons), e.g. 4"
                        read(*,*) kindmag(nkind)
                        atmkind(tmparr(1:ntmp))=nkind
                        iele=a(tmparr(1))%index
                        kindeleidx(nkind)=iele
                        isuffix=0
                        do while(.true.) !Test which suffix can be used
                            if (isuffix>0) then
                                write(c80tmp,"(i5)") isuffix
                                c80tmp=trim(ind2name(iele))//'_'//trim(adjustl(c80tmp))
                            else
                                c80tmp=ind2name(iele)
                            end if
                            if (all(kindname(1:nkind-1)/=trim(c80tmp))) then !New kind name
                                exit
                            else
                                ncount=count(kindname(atmkind(:))==trim(c80tmp))
                                if (ncount==0) exit
                            end if
                            isuffix=isuffix+1
                        end do
                        kindname(nkind)=trim(c80tmp)
                        write(*,*) "Done!"
                    else
                        write(*,*) "Error: Not all atoms you selected belong to the same element!"
                    end if
                end do
            else if (isel2==10) then
                write(*,*) "Choose printing level"
                write(*,*) "0 Silent"
                write(*,*) "1 Low"
                write(*,*) "2 Medium"
                write(*,*) "3 High"
                read(*,*) iprintlevel
            else if (isel2==11) then
                write(*,*) "Input external electric field vector in a.u., e.g. 0.0,0.0,0.025"
                read(*,*) efieldvec
            end if
        end do
    else if (isel==-7) then
        write(*,*) "Input one of following string to specify periodic boundary condition (PBC)"
        write(*,*) "NONE, X, XY, XYZ, XZ, Y, YZ, Z"
        read(*,*) PBCdir
    else if (isel==-6) then
        write(*,*) "Input frequency of writing molecular dynamics trajectory, 1 means every step"
        read(*,*) nMDsavefreq
    else if (isel==-5) then
        write(*,*) "Choose the format for recording MD trajectory"
        write(*,*) "1 xyz"
        write(*,*) "2 dcd (binary, small)"
        write(*,*) "3 pdb"
        read(*,*) iMDformat
    else if (isel==-4) then
        write(*,*) "Printing which kind of atomic charge?"
        write(*,*) "0 None"
        write(*,*) "1 Mulliken"
        write(*,*) "2 Lowdin"
        write(*,*) "3 Hirshfeld"
        write(*,*) "4 Hirshfeld-I"
        write(*,*) "5 Voronoi"
        write(*,*) "6 RESP"
        write(*,*) "7 REPEAT"
        read(*,*) iatomcharge
        if (ifPBC==0.and.iatomcharge==7) then
            write(*,*) "Error: REPEAT can only be used for periodic system"
            write(*,*) "Press ENTER button to continue"
            read(*,*)
            iatomcharge=0
        end if
    else if (isel==-3) then
        write(*,*) "Output cube file for which function?"
        write(*,*) "0 None"
        write(*,*) "1 Electron density (also with spin density for unrestricted calculation)"
        write(*,*) "2 Electron localization function (ELF)"
        write(*,*) "3 Exchange-correlation potential"
        write(*,*) "4 Hartree potential (negative of ESP)"
        write(*,*) "5 Each component of electric field"
        write(*,*) "6 Molecular orbital(s)"
        read(*,*) ioutcube
    else if (isel==-2) then
        if (imolden==0) then
            imolden=1
        else
            imolden=0
        end if
    else if (isel==-1) then
        write(*,*) "Please select task"
        write(*,*) "1 Energy"
        write(*,*) "2 Energy + force"
        write(*,*) "3 Optimizing structure (cell is fixed)"
        write(*,*) "4 Optimizing both structure and cell"
        write(*,*) "5 Vibrational analysis"
        write(*,*) "6 Molecular dynamics"
        write(*,*) "7 Searching transition state using dimer algorithm"
        !write(*,*) "8 Nudge-elastic band"
        write(*,*) "9 NMR"
        read(*,*) itask
        if (itask==9.and.ibas<=5) ibas=10 !Use 6-31G* if current basis set is pseudopotential basis set
        if (itask==5) iprintlevel=2 !Use medium printing level
    else if (isel==1) then !Functionals description: https://manual.cp2k.org/trunk/CP2K_INPUT/ATOM/METHOD/XC/XC_FUNCTIONAL.html
        !write(*,*) "-1 Molecular mechanism (MM)"
        write(*,*) "1 Pade (LDA)"
        write(*,*) "2 PBE        -2 revPBE     -3 PBEsol"
        write(*,*) "3 TPSS        4 BP86        5 BLYP"
        write(*,*) "6 PBE0       -6 PBE0 with ADMM"
        write(*,*) "7 B3LYP      -7 B3LYP with ADMM"
        write(*,*) "8 HSE06      -8 HSE06 with ADMM"
        write(*,*) "9 BEEF-vdW"
        !write(*,*) "11 PBEsol (via &LIBXC)" !I found the result is identical to native implementation, so do not appear here
        write(*,*) "11 B97M-rV (via &LIBXC)       12 MN15L (via &LIBXC)"
        write(*,*) "13 SCAN (via &LIBXC)          14 r2SCAN (via &LIBXC)"
        write(*,*) "15 RPBE (via &LIBXC)"
        write(*,*) "20 RI-MP2        21 RI-SCS-MP2"
        write(*,*) "25 RI-B2PLYP     26 RI-B2GP-PLYP     27 RI-DSD-BLYP"
        write(*,*) "30 GFN1-xTB      40 PM6"
        read(*,*) isel2
        iMP2=0 !Do not involve MP2 part
        if (isel2==1) method="Pade"
        if (isel2==2) method="PBE"
        if (isel2==-2) method="revPBE"
        if (isel2==-3) method="PBEsol"
        if (isel2==3) method="TPSS"
        if (isel2==4) method="BP"
        if (isel2==5) method="BLYP"
        if (isel2==6) method="PBE0"
        if (isel2==-6) method="PBE0_ADMM"
        if (isel2==7) method="B3LYP"
        if (isel2==-7) method="B3LYP_ADMM"
        if (isel2==8) method="HSE06"
        if (isel2==-8) method="HSE06_ADMM"
        if (isel2==9) then
            method="BEEFVDW"
            idispcorr=0
        end if
        !if (isel2==11) method="PBEsol_LIBXC"
        if (isel2==11) then
            method="B97M-rV_LIBXC"
            idispcorr=5
        end if
        if (isel2==12) method="MN15L_LIBXC"
        if (isel2==13) method="SCAN_LIBXC"
        if (isel2==14) method="r2SCAN_LIBXC"
        if (isel2==15) method="RPBE_LIBXC"
        if (isel2>=20.and.isel2<30) then !Involve MP2
            if (isel2==20) method="RI-MP2"
            if (isel2==21) method="RI-SCS-MP2"
            if (isel2==25) method="RI-B2PLYP"
            if (isel2==26) method="RI-B2GP-PLYP"
            if (isel2==27) method="RI-DSD-BLYP"
            iMP2=1
            ibas=21
        end if
        if (isel2==30) method="GFN1-xTB"
        if (isel2==40) method="PM6"
        if (isel2==-6.or.isel2==-7.or.isel2==30) idiagOT=2 !When ADMM is used, OT must also be used. OT is suggested for xTB dealing with large system
        if (isel2==40) imixing=1
    else if (isel==2) then
        write(*,"(a)") " Note: <=5, 20, 21 correspond to GPW calculation using GTH pseudopotential, the other ones correspond to full electron GAPW calculation"
        do i=-10,30
            if (basname(i)/=" ") write(*,"(1x,i2,1x,a)") i,trim(basname(i))
        end do
        read(*,*) ibassel
        if (iMP2==1.and.ibassel/=20.and.ibassel/=21) then
            write(*,"(a)") " Error: To perform RI calculation, you must choose 20 or 21, because they are accompanied by auxiliary basis set"
            write(*,*) "Press ENTER button to continue"
            read(*,*)
            pause
        end if
        ibas=ibassel
    else if (isel==3) then
        write(*,*) "Choose dispersion correction method"
        write(*,*) "0 None"
        write(*,*) "1 DFT-D3"
        write(*,*) "2 DFT-D3(BJ)"
        write(*,*) "5 rVV10"
        read(*,*) idispcorr
    else if (isel==4) then
        if (idiagOT==1) then
            if (ikpoint1/=1.or.ikpoint2/=1.or.ikpoint3/=1) then
                write(*,*) "Error: OT can only be used for Gamma point!"
                write(*,*) "Press ENTER button to continue"
                read(*,*)
                cycle
            end if
            if (ismear==1) then
                write(*,*) "Error: OT cannot be used in combination with smearing!"
                write(*,*) "Press ENTER button to continue"
                read(*,*)
                cycle
            end if
            idiagOT=2
        else if (idiagOT==2) then
            idiagOT=1
        end if
    else if (isel==5) then
        if (idiagOT==1) then
            write(*,*) "Choose how to mixing old and new density matrices"
            write(*,*) "1 Direct mixing with DIIS (default, usually poor)"
            write(*,*) "2 Broyden mixing"
            write(*,*) "3 Pulay mixing"
            read(*,*) imixing
        else if (idiagOT==2) then
            if (iouterSCF==0) then
                iouterSCF=1
            else
                iouterSCF=0
            end if
        end if
    else if (isel==6) then
        if (ismear==0) then
            ismear=1
        else
            ismear=0
        end if
    else if (isel==7) then
        if (iSCCS==0) then
            iSCCS=1
        else
            iSCCS=0
        end if
    else if (isel==8) then
        write(*,*) "Input number of k-points of MONKHORST-PACK in three directions, e.g. 8,6,2"
        read(*,*) ikpoint1,ikpoint2,ikpoint3
        if (idiagOT==2.and.(ikpoint1/=1.or.ikpoint2/=1.or.ikpoint3/=1)) then
            write(*,"(a)") " Warning: OT can be used for Gamma point only! Now diagonalization is used instead"
            write(*,*) "Press ENTER button to continue"
            read(*,*)
            idiagOT=1
        end if
    else if (isel==9) then
        write(*,*) "Input indices of the atoms to be constraint (fixed), e.g. 1,5,9-12,14-18"
        write(*,"(a)") " If inputting ""optH"", then only hydrogens will be optimized while others will be fixed"
        read(*,"(a)") c2000tmp
        if (.not.allocated(atmcons)) allocate(atmcons(ncenter))
        if (index(c2000tmp,"optH")/=0) then
            natmcons=0
            do iatm=1,ncenter
                if (a(iatm)%index==1) cycle
                natmcons=natmcons+1
                atmcons(natmcons)=iatm
            end do
        else
            call str2arr(c2000tmp,natmcons,atmcons)
        end if
        write(*,"(i8,' atoms will be fixed')") natmcons
    else if (isel==10) then
        if (itask==6) then
            write(*,*) "0 Do not use thermostat"
            write(*,*) "1 Adaptive-Langevin thermostat"
            write(*,"(a)") " 2 Canonical sampling through velocity rescaling (CSVR, also known as V-rescale, recommended!)"
            write(*,*) "3 Generalized Langevin Equation (GLE) thermostat"
            write(*,*) "4 Nose-Hoover thermostat"
            read(*,*) ithermostat
            if (ithermostat>0) then
                if (.not.allocated(thermoatm)) allocate(thermoatm(ncenter))
                nthermoatm=ncenter
                forall(iatm=1:ncenter) thermoatm(iatm)=iatm
            end if
        else if (itask==3.or.itask==4) then
            write(*,*) "Choose optimization method"
            write(*,*) "1 BFGS (Best choice for most situations)"
            write(*,*) "2 LBFGS (Suitable for very large systems)"
            write(*,"(a)") " 3 Conjugate gradient (More robust than BFGS and LBFGS especially when initial geometry &
            is far from minimum, unfortunately more expensive. Try it for difficult cases)"
            read(*,*) ioptmethod
        else if (itask==5) then
            if (ioutvibmol==0) then
                ioutvibmol=1
            else
                ioutvibmol=0
            end if
        end if
    else if (isel==11) then
        write(*,*) "Input indices of the atoms to whom the thermostat will be applied"
        write(*,*) "For example: 1,5,9-12,14-18"
        read(*,"(a)") c2000tmp
        if (.not.allocated(thermoatm)) allocate(thermoatm(ncenter))
        call str2arr(c2000tmp,nthermoatm,thermoatm)
    else if (isel==12) then
        write(*,*) "0 Do not use barostat"
        write(*,*) "1 Use barostat, flexible cell"
        write(*,*) "2 Use barostat, isotropic cell"
        read(*,*) ibarostat
    else if (isel==0) then
        exit
    end if
end do

open(ifileid,file=outname,status="replace")
write(ifileid,"(a)") "#Generated by Multiwfn"
call path2filename(filename,c200tmp)
write(ifileid,"(a)") "&GLOBAL"
call path2filename(outname,c200tmp)
write(ifileid,"(a)") "  PROJECT "//trim(c200tmp)
if (iprintlevel==0) write(ifileid,"(a)") "  PRINT_LEVEL SILENT"
if (iprintlevel==1) write(ifileid,"(a)") "  PRINT_LEVEL LOW"
if (iprintlevel==2) write(ifileid,"(a)") "  PRINT_LEVEL MEDIUM"
if (iprintlevel==3) write(ifileid,"(a)") "  PRINT_LEVEL HIGH"
if (itask==1) write(ifileid,"(a)") "  RUN_TYPE ENERGY"
if (itask==2) write(ifileid,"(a)") "  RUN_TYPE ENERGY_FORCE"
if (itask==3) write(ifileid,"(a)") "  RUN_TYPE GEO_OPT"
if (itask==4) write(ifileid,"(a)") "  RUN_TYPE CELL_OPT"
if (itask==5) write(ifileid,"(a)") "  RUN_TYPE VIBRATIONAL_ANALYSIS"
if (itask==6) write(ifileid,"(a)") "  RUN_TYPE MD"
if (itask==7) write(ifileid,"(a)") "  RUN_TYPE GEO_OPT"
if (itask==9) write(ifileid,"(a)") "  RUN_TYPE LR"
write(ifileid,"(a)") "&END GLOBAL"
write(ifileid,"(/,a)") "&FORCE_EVAL"
write(ifileid,"(a)") "  METHOD Quickstep"
write(ifileid,"(a)") "  &SUBSYS"
if (nrep1/=1.or.nrep2/=1.or.nrep3/=1) then
    write(ifileid,"(a)") "    &TOPOLOGY"
    write(ifileid,"(a,3i3)") "      MULTIPLE_UNIT_CELL",nrep1,nrep2,nrep3
    write(ifileid,"(a)") "    &END TOPOLOGY"
end if

!---- &CELL
write(ifileid,"(a)") "    &CELL"
if (ifPBC>0) then
    write(ifileid,"(a,3f15.8)") "      A",cellv1(:)*b2a
    write(ifileid,"(a,3f15.8)") "      B",cellv2(:)*b2a
    write(ifileid,"(a,3f15.8)") "      C",cellv3(:)*b2a
    if (nrep1/=1.or.nrep2/=1.or.nrep3/=1) write(ifileid,"(a,3i3)") "      MULTIPLE_UNIT_CELL",nrep1,nrep2,nrep3
    write(ifileid,"(a)") "      PERIODIC "//trim(PBCdir)//" #Direction of applied PBC (geometry aspect)"
else if (ifPBC==0) then
    extdist=2*rbuffer
    flenx=ceiling((maxval(a%x)-minval(a%x)+extdist)*b2a)
    fleny=ceiling((maxval(a%y)-minval(a%y)+extdist)*b2a)
    flenz=ceiling((maxval(a%z)-minval(a%z)+extdist)*b2a)
    !Cubic box, needed by Wavelet Poisson solver
    !flen=max(max(flenx,fleny),fenlz)
    !write(ifileid,"(a,3f10.3)") "      ABC",flen,flen,flen
    !Rectangle box, compatible with ANALYTIC Poisson solver
    write(ifileid,"(a,3f10.3)") "      ABC",flenx,fleny,flenz
    write(ifileid,"(a)") "      PERIODIC "//trim(PBCdir)//" #Direction of applied PBC (geometry aspect)"
end if
write(ifileid,"(a)") "    &END CELL"
if (ifPBC==0) then
    write(ifileid,"(a)") "    &TOPOLOGY"
    write(ifileid,"(a)") "      &CENTER_COORDINATES #Centering the atoms in the box"
    write(ifileid,"(a)") "      &END"
    write(ifileid,"(a)") "    &END"
end if

!---- &COORD
write(ifileid,"(a)") "    &COORD"
do iatm=1,ncenter
    write(ifileid,"(6x,a,3f14.8)") kindname(atmkind(iatm)),a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
end do
write(ifileid,"(a)") "    &END COORD"
if (itask==6) then
    write(ifileid,"(a)") "#   &VELOCITY #You can set initial atomic velocities in this section"
    write(ifileid,"(a)") "#   &END VELOCITY"
end if

!---- &KIND
if (method=="GFN1-xTB".or.method=="PM6") then
    !write(ifileid,"(a)") "    &KIND"
    !write(ifileid,"(a)") "      BASIS_SET"
    !write(ifileid,"(a)") "    &END KIND"
else
    do ikind=1,nkind
        if (count(atmkind(:)==ikind)==0) cycle
        write(ifileid,"(a)") "    &KIND "//kindname(ikind)
        write(ifileid,"(a)") "      ELEMENT "//ind2name(kindeleidx(ikind))
        if (ibas==20) then
            write(ifileid,"(a)") "      BASIS_SET cc-DZ"
            write(ifileid,"(a)") "      BASIS_SET RI_AUX RI_DZ"
        else if (ibas==21) then
            write(ifileid,"(a)") "      BASIS_SET cc-TZ"
            write(ifileid,"(a)") "      BASIS_SET RI_AUX RI_TZ"
        else
            write(ifileid,"(a)") "      BASIS_SET "//trim(basname(ibas))
        end if
        if (index(method,"ADMM")/=0) write(ifileid,"(a)") "      BASIS_SET AUX_FIT cFIT3" !Use ADMM
        if (ibas<=5.or.ibas==20.or.ibas==21) then !GPW
            if (method=="Pade") then
                write(ifileid,"(a)") "      POTENTIAL GTH-PADE"
            else if (method=="BP") then
                write(ifileid,"(a)") "      POTENTIAL GTH-BP"
            else if (method=="BLYP".or.method=="B3LYP") then
                write(ifileid,"(a)") "      POTENTIAL GTH-BLYP"
            else if (index(method,"MP2")/=0) then
                write(ifileid,"(a)") "      POTENTIAL GTH-HF"
            else
                write(ifileid,"(a)") "      POTENTIAL GTH-PBE"
            end if
        else !GAPW
            write(ifileid,"(a)") "      POTENTIAL ALL"
        end if
        if (iDFTplusU==1) then
            ie=kindeleidx(ikind)
            if ((ie>=21.and.ie<=28).or.(ie>=39.and.ie<=46).or.(ie>=57.and.ie<=78).or.ie>=89) then !Only +U for d or f element
                if (ie/=24.and.ie/=25.and.ie/=42.and.ie/=43.and.ie/=46.and.ie/=75) then !Ignore half-occupied d shell elements
                    write(ifileid,"(a)") "      &DFT_PLUS_U T"
                    write(ifileid,"(a)") "        L 2 #Quantum number of angular momentum the atomic orbitals to +U. 2=d, 3=f"
                    write(ifileid,"(a)") "        U_MINUS_J [eV] 3.9 #Effective on-site Coulomb interaction parameter U(eff) = U - J"
                    write(ifileid,"(a)") "      &END DFT_PLUS_U"
                end if
            end if
        end if
        if (kindmag(ikind)/=0) write(ifileid,"(a,i3)") "      MAGNETIZATION",kindmag(ikind)
        write(ifileid,"(a)") "    &END KIND"
    end do
end if
write(ifileid,"(a)") "  &END SUBSYS"

!---- &DFT
write(ifileid,"(/,a)") "  &DFT"
if (method/="GFN1-xTB".and.method/="PM6") then
    if (ibas<0) then
        write(ifileid,"(a)") "    BASIS_SET_FILE_NAME  GTH_BASIS_SETS"
    else if (ibas<=5) then
        write(ifileid,"(a)") "    BASIS_SET_FILE_NAME  BASIS_MOLOPT"
    else if (ibas==10.or.ibas==11.or.ibas==12.or.ibas==14) then
        write(ifileid,"(a)") "    BASIS_SET_FILE_NAME  EMSL_BASIS_SETS"
    else if (ibas==13) then
        write(ifileid,"(a)") "    BASIS_SET_FILE_NAME  BASIS_pob"
    else if (ibas==20.or.ibas==21) then
        write(ifileid,"(a)") "    BASIS_SET_FILE_NAME  BASIS_RI_cc-TZ"
    end if
    if (index(method,"ADMM")/=0) then !Set basis set file for ADMM
        write(ifileid,"(a)") "    BASIS_SET_FILE_NAME  BASIS_ADMM"
    end if
    if (index(method,"MP2")/=0) then
        write(ifileid,"(a)") "    POTENTIAL_FILE_NAME  HF_POTENTIALS"
    else
        write(ifileid,"(a)") "    POTENTIAL_FILE_NAME  POTENTIAL"
    end if
end if
write(ifileid,"(a)") "#   WFN_RESTART_FILE_NAME "//trim(c200tmp)//"-RESTART.wfn"
write(ifileid,"(a,i5,a)") "    CHARGE",netchg," #Net charge"
write(ifileid,"(a,i5,a)") "    MULTIPLICITY",multispin," #Spin multiplicity"
if (multispin>1.or.any(kindmag(1:nkind)/=0)) write(ifileid,"(a)") "    UKS"
if (any(efieldvec/=0)) then
    efieldmag=dsqrt(sum(efieldvec**2))
    write(ifileid,"(a)") "    &EFIELD"
    write(ifileid,"(a,f8.5)") "      INTENSITY",efieldmag
    write(ifileid,"(a,3f8.5)") "      POLARISATION",efieldvec/efieldmag
    write(ifileid,"(a)") "    &END EFIELD"
end if
if (ikpconvtest==1) then
    write(ifileid,"(a)") "    &KPOINTS"
    write(ifileid,"(a)") "      SCHEME MONKHORST-PACK kp_test"
    write(ifileid,"(a)") "      SYMMETRY F #If using symmetry to reduce the number of k-points"
    write(ifileid,"(a)") "    &END KPOINTS"
else if (ikpoint1/=1.or.ikpoint2/=1.or.ikpoint3/=1) then
    write(ifileid,"(a)") "    &KPOINTS"
    write(ifileid,"(a,3i3)") "      SCHEME MONKHORST-PACK",ikpoint1,ikpoint2,ikpoint3
    write(ifileid,"(a)") "      SYMMETRY F #If using symmetry to reduce the number of k-points"
    !write(ifileid,"(a)") "      KPOINT X Y Z weight" !Manually specify XYZ and weight of k-points
    !write(ifileid,"(a)") "      FULL_GRID T" !If using full non-reduced kpoint grid. Default is false
    write(ifileid,"(a)") "    &END KPOINTS"
end if
if (iDFTplusU==1) write(ifileid,"(a)") "    PLUS_U_METHOD MULLIKEN #The method used in DFT+U. Can also be Lowdin"

!---- &QS
write(ifileid,"(a)") "    &QS"
if (itask==9) then !Use better setting for NMR
    write(ifileid,"(a)") "      EPS_DEFAULT 1E-12 #This is default. Set all EPS_xxx to values such that the energy will be correct up to this value"
else
    write(ifileid,"(a)") "      EPS_DEFAULT 1E-10 #This is default. Set all EPS_xxx to values such that the energy will be correct up to this value"
end if
if (index(method,"B3LYP")/=0.or.index(method,"PBE0")/=0.or.index(method,"HSE06")/=0.or.index(method,"MP2")/=0) then
    write(ifileid,"(a)") "    # EPS_PGF_ORB 1E-8 #If seeing ""Kohn Sham matrix not 100% occupied"" when using HF, MP2 or hybrid functional, uncomment this"
end if
if (itask==6) then
    write(ifileid,"(a)") "      EXTRAPOLATION ASPC #Extrapolation for wavefunction during e.g. MD. ASPC is default, PS also be used"
    write(ifileid,"(a)") "      EXTRAPOLATION_ORDER 3 #Order for PS or ASPC extrapolation. 3 is default"
end if
if (method=="GFN1-xTB") then
    write(ifileid,"(a)") "      METHOD xTB"
    write(ifileid,"(a)") "      &xTB"
    if (ifPBC>0) write(ifileid,"(a)") "        DO_EWALD T" !Default is Coulomb way to calculate electrostatic interaction
    write(ifileid,"(a)") "        CHECK_ATOMIC_CHARGES F #xTB calculation often crashes without setting this to false"
    write(ifileid,"(a)") "        &PARAMETER"
    write(ifileid,"(a)") "          DISPERSION_PARAMETER_FILE dftd3.dat"
    write(ifileid,"(a)") "          PARAM_FILE_NAME xTB_parameters"
    write(ifileid,"(a)") "        &END PARAMETER"
    write(ifileid,"(a)") "      &END xTB"
else if (method=="PM6") then
    write(ifileid,"(a)") "      METHOD PM6"
    if (ifPBC>0) then
        write(ifileid,"(a)") "      &SE"
        write(ifileid,"(a)") "        PERIODIC EWALD"
        write(ifileid,"(a)") "      &END SE"
    end if
else if (ibas>=10.and.ibas<=19) then !These are all-electron basis sets
    write(ifileid,"(a)") "      METHOD GAPW"
else !Default is GPW using GTH pseudopotential, do no need to explicitly write
    continue
end if
write(ifileid,"(a)") "    &END QS"

!---- &POISSON
write(ifileid,"(a)") "    &POISSON" !How to deal with electrostatic part
if (method=="PM6") then !Very special
    write(ifileid,"(a)") "      &EWALD"
    write(ifileid,"(a)") "        &MULTIPOLES"
    write(ifileid,"(a)") "          MAX_MULTIPOLE_EXPANSION QUADRUPOLE"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "        EWALD_TYPE ewald"
    write(ifileid,"(a)") "        ALPHA  .5" !See e.g. https://github.com/misteliy/cp2k/blob/master/tests/SE/regtest-3/Al2O3.inp
    write(ifileid,"(a)") "        GMAX   31"
    write(ifileid,"(a)") "      &END EWALD"
else !Common case
    write(ifileid,"(a)") "      PERIODIC "//trim(PBCdir)//" #Direction(s) of PBC for calculating electrostatics"
    if (PBCdir=="NONE") then
        !WAVELET solver allows for non-periodic (PERIODIC NONE) conditions and slab-boundary conditions (but only PERIODIC XZ)
        !write(ifileid,"(a)") "       PSOLVER MT" !Martyna-Tuckerman poisson solver. Exact results are only guaranteed if the unit cell is twice as large as charge density
        !write(ifileid,"(a)") "      PSOLVER WAVELET #The way to solve Poisson equation. Can also be MT, ANALYTIC ..."
        write(ifileid,"(a)") "      PSOLVER ANALYTIC #The way to solve Poisson equation" !I found ANALYTIC is faster than WAVELET, and do not need cubic box, so best
    else if (PBCdir=="XYZ") then
        write(ifileid,"(a)") "      PSOLVER PERIODIC #The way to solve Poisson equation"
    else
        write(ifileid,"(a)") "      PSOLVER ANALYTIC #The way to solve Poisson equation"
    end if
end if
write(ifileid,"(a)") "    &END POISSON"

if (index(method,"ADMM")/=0) then !Use ADMM
    write(ifileid,"(a)") "    &AUXILIARY_DENSITY_MATRIX_METHOD"
    write(ifileid,"(a)") "      METHOD BASIS_PROJECTION"
    write(ifileid,"(a)") "      ADMM_PURIFICATION_METHOD MO_DIAG"
    write(ifileid,"(a)") "    &END AUXILIARY_DENSITY_MATRIX_METHOD"
end if

!---- &XC
if (method=="PM6".or.method=="GFN1-xTB") goto 100
write(ifileid,"(a)") "    &XC"
if (index(method,"LIBXC")/=0) then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL"
    write(ifileid,"(a)") "        &LIBXC"
    !if (method=="PBEsol_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  GGA_X_PBE_SOL"
    if (method=="B97M-rV_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_XC_B97M_V"
    if (method=="MN15L_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_X_MN15_L"
    if (method=="SCAN_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_X_SCAN"
    if (method=="r2SCAN_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_X_R2SCAN"
    if (method=="RPBE_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  GGA_X_RPBE"
    write(ifileid,"(a)") "        &END LIBXC"
    if (method/="B97M-rV_LIBXC") then !Also need to define correlation part
        write(ifileid,"(a)") "        &LIBXC"
        !if (method=="PBEsol_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  GGA_C_PBE_SOL"
        if (method=="MN15L_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_C_MN15_L"
        if (method=="SCAN_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_C_SCAN"
        if (method=="r2SCAN_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  MGGA_C_R2SCAN"
        if (method=="RPBE_LIBXC") write(ifileid,"(a)") "          FUNCTIONAL  GGA_C_PBE"
        write(ifileid,"(a)") "        &END LIBXC"
    end if
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (method=="GFN1-xTB".or.method=="PM6") then
    continue
else if (index(method,"PBE0")/=0) then
        !write(ifileid,"(a)") "      &XC_FUNCTIONAL PBE0" !In fact simply writing this is adequate, and "FRACTION 0.25" can be ignored
        write(ifileid,"(a)") "      &XC_FUNCTIONAL"
        write(ifileid,"(a)") "        &PBE"
        write(ifileid,"(a)") "          SCALE_X 0.75 #75% GGA exchange"
        write(ifileid,"(a)") "          SCALE_C 1.0 #100% GGA correlation"
        write(ifileid,"(a)") "        &END PBE"
        write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (index(method,"B3LYP")/=0) then
        write(ifileid,"(a)") "      &XC_FUNCTIONAL"
        write(ifileid,"(a)") "        &LYP"
        write(ifileid,"(a)") "          SCALE_C 0.81"
        write(ifileid,"(a)") "        &END "
        write(ifileid,"(a)") "        &BECKE88"
        write(ifileid,"(a)") "          SCALE_X 0.72"
        write(ifileid,"(a)") "        &END"
        write(ifileid,"(a)") "        &VWN"
        write(ifileid,"(a)") "          FUNCTIONAL_TYPE VWN3 #Adapt Gaussian's B3LYP definition"
        write(ifileid,"(a)") "          SCALE_C 0.19"
        write(ifileid,"(a)") "        &END"
        write(ifileid,"(a)") "        &XALPHA"
        write(ifileid,"(a)") "          SCALE_X 0.08"
        write(ifileid,"(a)") "        &END"
        write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (method=="revPBE".or.method=="PBEsol") then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL PBE"
    write(ifileid,"(a)") "        &PBE"
    if (method=="revPBE") write(ifileid,"(a)") "          PARAMETRIZATION REVPBE"
    if (method=="PBEsol") write(ifileid,"(a)") "          PARAMETRIZATION PBESOL"
    write(ifileid,"(a)") "        &END PBE"
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (index(method,"HSE")/=0) then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL"
    write(ifileid,"(a)") "        &XWPBE"
    write(ifileid,"(a)") "          SCALE_X -0.25"
    write(ifileid,"(a)") "          SCALE_X0 1.0"
    write(ifileid,"(a)") "          OMEGA 0.11"
    write(ifileid,"(a)") "        &END XWPBE"
    write(ifileid,"(a)") "        &PBE"
    write(ifileid,"(a)") "          SCALE_X 0.0"
    write(ifileid,"(a)") "          SCALE_C 1.0"
    write(ifileid,"(a)") "        &END PBE"
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (index(method,"MP2")/=0) then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL NONE"
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (index(method,"B2PLYP")/=0) then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL"
    write(ifileid,"(a)") "        &LYP"
    write(ifileid,"(a)") "          SCALE_C  0.73"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "        &BECKE88"
    write(ifileid,"(a)") "          SCALE_X  0.47"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (index(method,"B2GP-PLYP")/=0) then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL"
    write(ifileid,"(a)") "        &LYP"
    write(ifileid,"(a)") "          SCALE_C  0.64"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "        &BECKE88"
    write(ifileid,"(a)") "          SCALE_X  0.35"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else if (index(method,"DSD-BLYP")/=0) then
    write(ifileid,"(a)") "      &XC_FUNCTIONAL"
    write(ifileid,"(a)") "        &LYP"
    write(ifileid,"(a)") "          SCALE_C  0.69"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "        &BECKE88"
    write(ifileid,"(a)") "          SCALE_X  0.31"
    write(ifileid,"(a)") "        &END"
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
else !Common native GGA functionals
    write(ifileid,"(a)") "      &XC_FUNCTIONAL "//trim(method)
    write(ifileid,"(a)") "      &END XC_FUNCTIONAL"
end if
!HF part for hybrid functionals
if (index(method,"PBE0")/=0.or.index(method,"B3LYP")/=0.or.index(method,"HSE")/=0.or.iMP2==1) then !Truncate HFX potential
    write(ifileid,"(a)") "      &HF"
    if (index(method,"PBE0")/=0.or.index(method,"HSE")/=0) write(ifileid,"(a)") "        FRACTION 0.25"
    if (index(method,"B3LYP")/=0) write(ifileid,"(a)") "        FRACTION 0.20"
    if (index(method,"MP2")/=0) write(ifileid,"(a)") "        FRACTION 1.0"
    if (index(method,"B2PLYP")/=0) write(ifileid,"(a)") "        FRACTION 0.53"
    if (index(method,"B2GP-PLYP")/=0) write(ifileid,"(a)") "        FRACTION 0.65"
    if (index(method,"DSD-BLYP")/=0) write(ifileid,"(a)") "        FRACTION 0.69"
    write(ifileid,"(a)") "        &SCREENING"
    if (iMP2==1) then !For double-hybrid or MP2 calculation, use tighter threshold for screening
        write(ifileid,"(a)") "          EPS_SCHWARZ 1E-10 #Important to improve scaling. The larger the value, the lower the cost and lower the accuracy"
    else
        write(ifileid,"(a)") "          EPS_SCHWARZ 1E-8 #Important to improve scaling. The larger the value, the lower the cost and lower the accuracy"
    end if
    write(ifileid,"(a)") "          SCREEN_ON_INITIAL_P T #Screening on product between maximum of density matrix elements and ERI"
    write(ifileid,"(a)") "        &END SCREENING"
    write(ifileid,"(a)") "        &INTERACTION_POTENTIAL"
    if (index(method,"HSE")/=0) then
        write(ifileid,"(a)") "          POTENTIAL_TYPE SHORTRANGE"
        write(ifileid,"(a)") "          OMEGA 0.11"
    else
        write(ifileid,"(a)") "          POTENTIAL_TYPE TRUNCATED"
        !Set CUTOFF_RADIUS to 1/2.1 of shortest box length, as suggested in CP2K input editor
        v1n=dsqrt(sum(cellv1**2))
        v2n=dsqrt(sum(cellv2**2))
        v3n=dsqrt(sum(cellv3**2))
        rad=min(min(v1n,v2n),v3n)*b2a/2.1D0
        if (ifPBC==0.or.rad>6) then !If half of shortest box length is larger than 6 Angstrom, simply use 6, this is adequate
            write(ifileid,"(a,f8.4)") "          CUTOFF_RADIUS 6.0 #Cutoff radius for truncated 1/r potential"
        else
            write(ifileid,"(a,f8.4,a)") "          CUTOFF_RADIUS",rad," #Cutoff radius for truncated 1/r potential"
        end if
        write(ifileid,"(a)") "          T_C_G_DATA t_c_g.dat"
    end if
    write(ifileid,"(a)") "        &END INTERACTION_POTENTIAL"
    write(ifileid,"(a)") "        &MEMORY"
    write(ifileid,"(a)") "          MAX_MEMORY 3000 #Memory(MB) per MPI process for calculating HF exchange"
    !Scaling factor to scale EPS_SCHWARZ. Storage threshold for compression will be EPS_SCHWARZ*EPS_STORAGE_SCALING
    write(ifileid,"(a)") "          EPS_STORAGE_SCALING 0.1"
    write(ifileid,"(a)") "        &END MEMORY"
    write(ifileid,"(a)") "      &END HF"
    !MP2 part
    if (iMP2==1) then
        write(ifileid,"(a)") "      &WF_CORRELATION"
        write(ifileid,"(a)") "        &RI_MP2"
        write(ifileid,"(a)") "        &END RI_MP2"
        if (index(method,"SCS-MP2")/=0) then
            write(ifileid,"(a)") "        SCALE_S 1.2"
            write(ifileid,"(a)") "        SCALE_T 0.3333333"
        else if (index(method,"B2PLYP")/=0) then
            write(ifileid,"(a)") "        SCALE_S 0.27"
            write(ifileid,"(a)") "        SCALE_T 0.27"
        else if (index(method,"B2GP-PLYP")/=0) then
            write(ifileid,"(a)") "        SCALE_S 0.36"
            write(ifileid,"(a)") "        SCALE_T 0.36"
        else if (index(method,"DSD-BLYP")/=0) then
            write(ifileid,"(a)") "        SCALE_S 0.46"
            write(ifileid,"(a)") "        SCALE_T 0.37"
        end if
        write(ifileid,"(a)") "        &INTEGRALS"
        write(ifileid,"(a)") "          &WFC_GPW"
        write(ifileid,"(a)") "            CUTOFF      300"
        write(ifileid,"(a)") "            REL_CUTOFF  50"
        write(ifileid,"(a)") "            EPS_FILTER  1.0E-12"
        write(ifileid,"(a)") "            EPS_GRID    1.0E-8"
        write(ifileid,"(a)") "          &END"
        write(ifileid,"(a)") "        &END INTEGRALS"
        write(ifileid,"(a)") "        MEMORY    3000 #Maximum allowed total memory usage (MB) during MP2 part"
        write(ifileid,"(a)") "        GROUP_SIZE  1 #Default. Also known as NUMBER_PROC"
        write(ifileid,"(a)") "      &END WF_CORRELATION"
    end if
end if

!--- Dispersion correction
if (idispcorr>0.or.method=="BEEFVDW") then
    write(ifileid,"(a)") "      &VDW_POTENTIAL"
    if (idispcorr==1.or.idispcorr==2) then
        write(ifileid,"(a)") "        POTENTIAL_TYPE PAIR_POTENTIAL"
        write(ifileid,"(a)") "        &PAIR_POTENTIAL"
        write(ifileid,"(a)") "          PARAMETER_FILE_NAME dftd3.dat"
        if (idispcorr==1) write(ifileid,"(a)") "          TYPE DFTD3"
        if (idispcorr==2) write(ifileid,"(a)") "          TYPE DFTD3(BJ)"
        !See qs_dispersion_pairpot.F on how to write functional name
        if (method=="BP") then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL BP86"
        else if (method=="PBEsol_LIBXC") then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL PBEsol"
        else if (method=="MN15L_LIBXC") then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL MN15L"
        else if (method=="SCAN_LIBXC") then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL SCAN"
        else if (index(method,"B2PLYP")/=0) then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL B2PLYP"
        else if (index(method,"B2GP-PLYP")/=0) then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL B2GPPLYP"
        else if (index(method,"DSD-BLYP")/=0) then
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL DSD-BLYP"
        else
            c80tmp=trim(method)
            ipos=index(c80tmp,"_ADMM")
            if (ipos/=0) c80tmp(ipos:ipos+4)=""
            write(ifileid,"(a)") "          REFERENCE_FUNCTIONAL "//trim(c80tmp)
        end if
        !write(ifileid,"(a)") "          R_CUTOFF 10.5835442" !Default DFT-D potential range, cutoff will be 2 times this value
        write(ifileid,"(a)") "        &END PAIR_POTENTIAL"
    else if (idispcorr==5.or.method=="BEEFVDW") then
        write(ifileid,"(a)") "        POTENTIAL_TYPE NON_LOCAL"
        write(ifileid,"(a)") "        &NON_LOCAL"
        if (idispcorr==5) then
            write(ifileid,"(a)") "          TYPE RVV10"
            if (method=="B97M-rV_LIBXC") then !See: Ab initio molecular dynamics simulations of liquid water using high quality meta-GGA functionals
                write(ifileid,"(a)") "          PARAMETERS 6.0 0.01"
            else
                write(ifileid,"(a)") "    #The default rVV10 b and c parameters are given below. They should be replaced by proper values for current XC functional"
                write(ifileid,"(a)") "          PARAMETERS 6.3 9.3E-3"
            end if
            write(ifileid,"(a)") "          KERNEL_FILE_NAME rVV10_kernel_table.dat"
        else if (method=="BEEFVDW") then
            write(ifileid,"(a)") "          TYPE LMKLL"
            write(ifileid,"(a)") "          KERNEL_FILE_NAME vdW_kernel_table.dat"
        end if
        write(ifileid,"(a)") "        &END NON_LOCAL"
    end if
    write(ifileid,"(a)") "      &END VDW_POTENTIAL"
end if
if (ifineXCgrid==1) then
    write(ifileid,"(a)") "      &XC_GRID"
    write(ifileid,"(a)") "        USE_FINER_GRID T #Use finer grid for calculating XC"
    write(ifileid,"(a)") "      &END XC_GRID"
end if
write(ifileid,"(a)") "    &END XC"
100 continue

!--- &MGRID
if (method/="GFN1-xTB".and.method/="PM6") then
    write(ifileid,"(a)") "    &MGRID"
    if (iconvtest==1) then
        write(ifileid,"(a)") "      CUTOFF LT_cutoff"
        write(ifileid,"(a)") "      REL_CUTOFF LT_rel_cutoff"
    else
        if (itask==1) then !Single point, medicore accuracy
            write(ifileid,"(a)") "      CUTOFF 350"
            write(ifileid,"(a)") "      REL_CUTOFF 50"
        else if (itask==6) then !MD, do not need high accuracy
            write(ifileid,"(a)") "      CUTOFF 300" !Default is 280
            write(ifileid,"(a)") "      REL_CUTOFF 40" !Default is 40
        else !If task involves energy derivative, use higher cutoff
            write(ifileid,"(a)") "      CUTOFF 400"
            write(ifileid,"(a)") "      REL_CUTOFF 55"
        end if
    end if
    if (ibas==3.or.ibas==4.or.ibas==5) write(ifileid,"(a)") "      NGRIDS 5 #The number of multigrids to use. 5 is optimal for MOLOPT-GTH basis sets"
    write(ifileid,"(a)") "    &END MGRID"
end if

!--- &SCF
write(ifileid,"(a)") "    &SCF"
if (iconvtest==1) then
    write(ifileid,"(a)") "      MAX_SCF 1"
else
    if (idiagOT==1) then !Diagonalization
        write(ifileid,"(a)") "      MAX_SCF 128"
    else !OT, usually use more cycles
        if (iouterSCF==0) write(ifileid,"(a)") "      MAX_SCF 200 #Should be set to a small value (e.g. 30) if enabling outer SCF"
        if (iouterSCF==1) write(ifileid,"(a)") "      MAX_SCF 20 #Maximum number of steps of inner SCF"
    end if
end if
if (imixing==1) then
    write(ifileid,"(a)") "      MAX_DIIS 7 #Maximum number of DIIS vectors to be used" !The default 4 is too small
    write(ifileid,"(a)") "      EPS_DIIS 0.3 #Threshold on the convergence to start using DIAG/DIIS" !The default 0.1 is too small
end if
if (itask==1) then !Single point and MD, do not need high accuracy
    eps_scf=5D-6
else if (itask==6) then !For faster MD, use even looser threshold
    eps_scf=1D-5
else if (itask==5) then !Vibration analysis is realized based on finite difference, so use tight convergence as suggested by manual
    eps_scf=1D-7
else if (itask==9) then !NMR may need pretty tight threshold
    eps_scf=1D-8
else !Other tasks involving energy derivative, use tighter convergence
    eps_scf=3D-6
end if
if (iouterSCF==0) write(ifileid,"(a,1PE8.1,a)") "      EPS_SCF",eps_scf," #Convergence threshold of density matrix during SCF"
if (iouterSCF==1) write(ifileid,"(a,1PE8.1,a)") "      EPS_SCF",eps_scf," #Convergence threshold of density matrix of inner SCF"
!if (method=="GFN1-xTB".or.method=="PM6") write(ifileid,"(a)") "      SCF_GUESS MOPAC" !Seems they benefit from this
write(ifileid,"(a)") "#     SCF_GUESS RESTART #Use wavefunction from WFN_RESTART_FILE_NAME file as initial guess"
if (idiagOT==1) then
    write(ifileid,"(a)") "      &DIAGONALIZATION"
    write(ifileid,"(a)") "        ALGORITHM STANDARD #Algorithm for diagonalization. DAVIDSON is faster for large systems"
    write(ifileid,"(a)") "      &END DIAGONALIZATION"
else if (idiagOT==2) then
    write(ifileid,"(a)") "      &OT"
    if (method=="GFN1-xTB".or.method=="PM6") then !Semi-empirical cannot use FULL_KINETIC. For large system FULL_SINGLE_INVERSE is the only good choice
        write(ifileid,"(a)") "        PRECONDITIONER FULL_SINGLE_INVERSE"
    else
        if (ncenter>150) then !Large system, using FULL_ALL will cause too high cost at the first step
            write(ifileid,"(a)") "        PRECONDITIONER FULL_KINETIC #FULL_SINGLE_INVERSE is also worth to try. FULL_ALL is better but quite expensive for large system"
        else
            write(ifileid,"(a)") "        PRECONDITIONER FULL_ALL #Usually best but expensive for large system. Cheaper: FULL_SINGLE_INVERSE and FULL_KINETIC (default)"
        end if
    end if
    write(ifileid,"(a)") "        MINIMIZER DIIS #CG is worth to consider in difficult cases" !BROYDEN in fact can also be used, but quite poor!
    write(ifileid,"(a)") "        LINESEARCH 2PNT #1D line search algorithm for CG. 2PNT is default, 3PNT is better but more costly. GOLD is best but very expensive"
    write(ifileid,"(a)") "      &END OT"
    if (iouterSCF==0) then
        write(ifileid,"(a)") "      #Uncomment following lines can enable outer SCF"
        write(ifileid,"(a)") "      #&OUTER_SCF"
        write(ifileid,"(a)") "      #  MAX_SCF 20 #Maximum number of steps of outer SCF"
        write(ifileid,"(a,1PE8.1,a)") "      #  EPS_SCF",eps_scf," #Convergence threshold of outer SCF"
        write(ifileid,"(a)") "      #&END OUTER_SCF"
    else if (iouterSCF==1) then
        write(ifileid,"(a)") "       &OUTER_SCF"
        write(ifileid,"(a)") "         MAX_SCF 20 #Maximum number of steps of outer SCF"
        write(ifileid,"(a,1PE8.1,a)") "         EPS_SCF",eps_scf," #Convergence threshold of outer SCF"
        write(ifileid,"(a)") "       &END OUTER_SCF"
    end if
end if

if (idiagOT==1) then
    !--- &MIXING
    write(ifileid,"(a)") "      &MIXING #How to mix old and new density matrices"
    if (imixing==1) then !PM6 and only use this
        write(ifileid,"(a)") "        METHOD DIRECT_P_MIXING"
        write(ifileid,"(a)") "        ALPHA 0.4 #Default. Mixing 40% of new density matrix with the old one"
    else if (imixing==2) then
        write(ifileid,"(a)") "        METHOD BROYDEN_MIXING #PULAY_MIXING is also a good alternative"
        write(ifileid,"(a)") "        ALPHA 0.4 #Default. Mixing 40% of new density matrix with the old one"
        write(ifileid,"(a)") "        NBROYDEN 8 #Default is 4. Number of previous steps stored for the actual mixing scheme" !Equivalent to NBUFFER
    else if (imixing==3) then
        write(ifileid,"(a)") "        METHOD PULAY_MIXING #BROYDEN_MIXING is also a good alternative"
        write(ifileid,"(a)") "        NPULAY 8 #Default is 4. Number of previous steps stored for the actual mixing scheme" !Equivalent to NBUFFER
    end if
    write(ifileid,"(a)") "      &END MIXING"
    !--- &SMEAR
    if (ismear==1) then
        write(ifileid,"(a)") "      &SMEAR"
        write(ifileid,"(a)") "        METHOD FERMI_DIRAC" !Can also be ENERGY_WINDOW, LIST
        write(ifileid,"(a)") "        ELECTRONIC_TEMPERATURE 300 #Electronic temperature of Fermi-Dirac smearing in K"
        write(ifileid,"(a)") "      &END SMEAR"
        if (multispin>1) then
            write(ifileid,"(a)") "      ADDED_MOS 30 30 #Number of virtual MOs to be solved for alpha and beta spins"
        else
            write(ifileid,"(a)") "      ADDED_MOS 30 #Number of virtual MOs to be solved"
        end if
    end if
end if
if (itask==3.or.itask==4.or.itask==6.or.itask==7) then
    write(ifileid,"(a)") "      &PRINT"
    write(ifileid,"(a)") "        &RESTART #Use ""&RESTART OFF"" can prevent generating wfn file"
    write(ifileid,"(a)") "          BACKUP_COPIES 0 #Maximum number of backup copies of wfn file"
    write(ifileid,"(a)") "        &END RESTART"
    write(ifileid,"(a)") "      &END PRINT"
end if
write(ifileid,"(a)") "    &END SCF"

!--- &PRINT of DFT level
if (imolden==1.or.ioutcube>0.or.iatomcharge>0.or.itask==5.or.imoment==1) then
    write(ifileid,"(a)") "    &PRINT"
    if (imolden==1) then
        write(ifileid,"(a)") "      &MO_MOLDEN"
        write(ifileid,"(a)") "        NDIGITS 8"
        write(ifileid,"(a)") "        GTO_KIND SPHERICAL"
        write(ifileid,"(a)") "      &END MO_MOLDEN"
    end if
    if (ioutcube>0) then
        if (ioutcube==1) then
            write(ifileid,"(a)") "      &E_DENSITY_CUBE"
            write(ifileid,"(a)") "        STRIDE 1 #Stride of exported cube file"
            write(ifileid,"(a)") "      &END E_DENSITY_CUBE"
        else if (ioutcube==2) then
            write(ifileid,"(a)") "      &ELF_CUBE"
            write(ifileid,"(a)") "        STRIDE 1 #Stride of exported cube file"
            write(ifileid,"(a)") "      &END ELF_CUBE"
        else if (ioutcube==3) then
            write(ifileid,"(a)") "      &V_XC_CUBE"
            write(ifileid,"(a)") "        STRIDE 1 #Stride of exported cube file"
            write(ifileid,"(a)") "      &END V_XC_CUBE"
        else if (ioutcube==4) then
            write(ifileid,"(a)") "      &V_HARTREE_CUBE"
            write(ifileid,"(a)") "        STRIDE 1 #Stride of exported cube file"
            write(ifileid,"(a)") "      &END V_HARTREE_CUBE"
        else if (ioutcube==5) then
            write(ifileid,"(a)") "      &EFIELD_CUBE"
            write(ifileid,"(a)") "        STRIDE 1 #Stride of exported cube file"
            write(ifileid,"(a)") "      &END EFIELD_CUBE"
        else if (ioutcube==6) then
            write(ifileid,"(a)") "      &MO_CUBES"
            write(ifileid,"(a)") "        STRIDE 1 #Stride of exported cube file"
            write(ifileid,"(a)") "        NHOMO 1"
            write(ifileid,"(a)") "        NLUMO 0"
            write(ifileid,"(a)") "      &END MO_CUBES"
        end if
    end if
    if (iatomcharge>0) then
        if (iatomcharge==1) then
            write(ifileid,"(a)") "      &MULLIKEN"
            write(ifileid,"(a)") "        PRINT_ALL F #If T, then printing full net AO and overlap population matrix"
            write(ifileid,"(a)") "      &END MULLIKEN"
        else if (iatomcharge==2) then
            write(ifileid,"(a)") "      &LOWDIN"
            write(ifileid,"(a)") "        PRINT_ALL F #If T, then printing full net AO and overlap population matrix"
            write(ifileid,"(a)") "      &END LOWDIN"
        else if (iatomcharge==3.or.iatomcharge==4) then
            write(ifileid,"(a)") "      &HIRSHFELD"
            write(ifileid,"(a)") "        SHAPE_FUNCTION DENSITY"
            if (iatomcharge==4) write(ifileid,"(a)") "        SELF_CONSISTENT T"
            write(ifileid,"(a)") "      &END HIRSHFELD"
        else if (iatomcharge==5) then
            write(ifileid,"(a)") "      &VORONOI"
            write(ifileid,"(a)") "        VORONOI_RADII Covalent" !Better than default of using vdW radii
            write(ifileid,"(a)") "      &END VORONOI"
        end if
    end if
    if (itask==5.or.imoment==1) then
        write(ifileid,"(a)") "      &MOMENTS"
        if (PBCdir=="NONE") then
            write(ifileid,"(a)") "        PERIODIC .FALSE."
            write(ifileid,"(a)") "        REFERENCE COM"
        end if
        write(ifileid,"(a)") "      &END MOMENTS"
    end if
    if (iSCCS==1) then
        write(ifileid,"(a)") "      @IF 1 #Printing SCCS information in each SCF iteration" !When print level is medium, will also print SCCS iteration information
        write(ifileid,"(a)") "      &SCCS"
        write(ifileid,"(a)") "        &EACH"
        write(ifileid,"(a)") "          QS_SCF 1"
        write(ifileid,"(a)") "        &END EACH"
        write(ifileid,"(a)") "      &END SCCS"
        write(ifileid,"(a)") "      @ENDIF"
    end if
    write(ifileid,"(a)") "    &END PRINT"
end if
if (iSCCS==1) then
    write(ifileid,"(a)") "    &SCCS"
    write(ifileid,"(a)") "      ALPHA [N*m^-1] 0.0"
    write(ifileid,"(a)") "      BETA [kbar] 0.0"
    write(ifileid,"(a)") "      GAMMA [mN/m] 0.0"
    write(ifileid,"(a)") "      DIELECTRIC_CONSTANT 78.36 #Water"
    write(ifileid,"(a)") "      EPS_SCCS 1E-6 #Default. Requested accuracy for the SCCS iteration cycle"
    write(ifileid,"(a)") "      EPS_SCF 0.5 #Default. SCCS iteration is activated only if SCF iteration is converged to this threshold"
    write(ifileid,"(a)") "      MAX_ITER 100 #Default. Maximum number of SCCS iteration steps"
    write(ifileid,"(a)") "      DERIVATIVE_METHOD FFT #Default. Method for calculation of numerical derivatives. Can also be CD3, CD5, CD7"
    write(ifileid,"(a)") "      &ANDREUSSI"
    write(ifileid,"(a)") "        RHO_MAX 0.0035 #Default"
    write(ifileid,"(a)") "        RHO_MIN 0.0001 #Default"
    write(ifileid,"(a)") "      &END ANDREUSSI"
    write(ifileid,"(a)") "    &END SCCS"
end if
if (idipcorr>0) then
    write(ifileid,"(a)") "    SURFACE_DIPOLE_CORRECTION T"
    if (idipcorr==1) write(ifileid,"(a)") "    SURF_DIP_DIR X"
    if (idipcorr==2) write(ifileid,"(a)") "    SURF_DIP_DIR Y"
    if (idipcorr==3) write(ifileid,"(a)") "    SURF_DIP_DIR Z"
end if
write(ifileid,"(a)") "  &END DFT"

if (itask==2) then
    write(ifileid,"(a)") "  &PRINT"
    write(ifileid,"(a)") "    &FORCES ON"
    write(ifileid,"(a)") "    &END FORCES"
    write(ifileid,"(a)") "  &END PRINT"
end if
if (itask==4.or.ibarostat>0) write(ifileid,"(a)") "  STRESS_TENSOR ANALYTICAL"
if (itask==9) then !NMR
    write(ifileid,"(a)") "  &PROPERTIES"
    write(ifileid,"(a)") "    &LINRES #Activate linear response calculation"
    if (ncenter>150) then
        write(ifileid,"(a)") "      PRECONDITIONER FULL_KINETIC #Preconditioner to be used with all minimization schemes"
    else
        write(ifileid,"(a)") "      PRECONDITIONER FULL_ALL #Preconditioner to be used with all minimization schemes"
    end if
    write(ifileid,"(a)") "      EPS 1E-10 #Target accuracy for the convergence of the conjugate gradient" !Tigher than default 1E-6
    write(ifileid,"(a)") "      MAX_ITER 300 #Maximum number of conjugate gradient iteration to be performed for one optimization"
    write(ifileid,"(a)") "      &CURRENT"
    !write(ifileid,"(a)") "        GAUGE R_AND_STEP_FUNCTION #Default. The gauge used to compute the induced current within GAPW" !I found the default is the only useful choice
    !Use ATOM can keep shielding tensor symmetry much better than WANNIER
    write(ifileid,"(a)") "        ORBITAL_CENTER ATOM #The orbital center. Can also be WANNIER (default)"
    write(ifileid,"(a)") "      &END CURRENT"
    write(ifileid,"(a)") "      &LOCALIZE"
    !I found CRAZY doesn't properly work, so do not explicitly mention, just use default JACOBI
    !write(ifileid,"(a)") "	      METHOD JACOBI #Localization optimization method. JACOBI=2x2 orbital rotations. CRAZY is less robust but usually much faster"
    write(ifileid,"(a)") "	      MAX_ITER 300 #Maximum number of iterations used for localization methods"
    !I found BOYS and PIPEK do not work, so do not explicitly mention them, just use default BERRY
    !write(ifileid,"(a)") "	      OPERATOR BERRY #The quantity to be minimized in localization. Can also be BOYS and PIPEK"
    write(ifileid,"(a)") "      &END LOCALIZE"
    write(ifileid,"(a)") "      &NMR"
    write(ifileid,"(a)") "      #  NICS T #Calculate NICS"
    write(ifileid,"(a)") "      #  NICS_FILE_NAME filepath #Path of the file containing NICS points coordinates"
    write(ifileid,"(a)") "      &END NMR"
    write(ifileid,"(a)") "    &END LINRES"
    write(ifileid,"(a)") "  &END PROPERTIES"
end if
if (iatomcharge==6.or.iatomcharge==7) then
    write(ifileid,"(/,a)") "  &PROPERTIES"
    write(ifileid,"(a)") "    &RESP"
    if (iatomcharge==7) write(ifileid,"(a)") "    USE_REPEAT_METHOD T"
    write(ifileid,"(a)") "      &SPHERE_SAMPLING"
    write(ifileid,"(a)") "        AUTO_VDW_RADII_TABLE CAMBRIDGE #vdW radii type. This is default. Can also be UFF"
    write(ifileid,"(a)") "        AUTO_RMIN_SCALE 1.0 #Scaled factor of vdW radii determining the inner boundary of sampling"
    write(ifileid,"(a)") "        AUTO_RMAX_SCALE 2.0 #Scaled factor of vdW radii determining the outer boundary of sampling"
    write(ifileid,"(a)") "      &END SPHERE_SAMPLING"
    if (ifPBC>0) then
        write(ifileid,"(a)") "      #Uncomment following lines can use slab sampling of fitting points"
        write(ifileid,"(a)") "      #&SLAB_SAMPLING #The fitting points will sampled above a slab"
        write(ifileid,"(a)") "      #  RANGE 2.0 4.0"
        write(ifileid,"(a)") "      #  LENGTH 3.0"
        write(ifileid,"(a)") "      #  ATOM_LIST 1..32 #List of considered atoms"
        write(ifileid,"(a)") "      #  SURF_DIRECTION Z #What above the surface means. Can also be e.g. -Z, X, Z..."
        write(ifileid,"(a)") "      #&END SLAB_SAMPLING"
    end if
    write(ifileid,"(a)") "      &PRINT"
    write(ifileid,"(a)") "        &COORD_FIT_POINTS"
    write(ifileid,"(a)") "        &END COORD_FIT_POINTS"
    write(ifileid,"(a)") "        &RESP_CHARGES_TO_FILE"
    write(ifileid,"(a)") "        &END RESP_CHARGES_TO_FILE"
    write(ifileid,"(a)") "      &END PRINT"
    write(ifileid,"(a)") "    &END RESP"
    write(ifileid,"(a)") "  &END PROPERTIES"
end if
write(ifileid,"(a)") "&END FORCE_EVAL"

!--- &MOTION
if (itask>=3.and.itask<=7) then
    write(ifileid,"(/,a)") "&MOTION"
    if (itask==3.or.itask==7) then !Optimizing atoms for minimum or TS
        write(ifileid,"(a)") "  &GEO_OPT"
        if (itask==3) then
            write(ifileid,"(a)") "    TYPE MINIMIZATION #Search for minimum"
            if (ioptmethod==1) then
                write(ifileid,"(a)") "    OPTIMIZER BFGS #Can also be CG (more robust for difficult cases) or LBFGS"
                write(ifileid,"(a)") "    &BFGS"
                write(ifileid,"(a)") "      TRUST_RADIUS 0.2 #Trust radius (maximum stepsize) in Angstrom"
                write(ifileid,"(a)") "#     RESTART_HESSIAN T #If read initial Hessian, uncomment this line and specify the file in the next line"
                write(ifileid,"(a)") "#     RESTART_FILE_NAME to_be_specified"
                write(ifileid,"(a)") "    &END BFGS"
            else if (ioptmethod==2) then
                write(ifileid,"(a)") "    OPTIMIZER LBFGS #Can also be CG (more robust for difficult cases) or BFGS"
            else if (ioptmethod==3) then
                write(ifileid,"(a)") "    OPTIMIZER CG #Can also be BFGS or LBFGS"
                write(ifileid,"(a)") "    &CG"
                write(ifileid,"(a)") "      &LINE_SEARCH"
                write(ifileid,"(a)") "        TYPE 2PNT #Two-point extrapolation, cheap while acceptable. Can also be FIT, GOLD"
                write(ifileid,"(a)") "      &END LINE_SEARCH"
                write(ifileid,"(a)") "    &END CG"
            end if
        else if (itask==7) then
            write(ifileid,"(a)") "    TYPE TRANSITION_STATE #Optimizing TS using dimer algorithm"
            write(ifileid,"(a)") "    OPTIMIZER CG" !CG is the only choice for dimer
            write(ifileid,"(a)") "    &CG"
            write(ifileid,"(a)") "      &LINE_SEARCH"
            write(ifileid,"(a)") "        TYPE 2PNT"
            write(ifileid,"(a)") "      &END LINE_SEARCH"
            write(ifileid,"(a)") "    &END CG"
            write(ifileid,"(a)") "    &TRANSITION_STATE"
            write(ifileid,"(a)") "      &DIMER"
            write(ifileid,"(a)") "        DR 0.01 #Default. DR parameter"
            write(ifileid,"(a)") "        ANGLE_TOLERANCE [deg] 4.0 #Tolerance angle for line search performed to optimize dimer orientation"
            write(ifileid,"(a)") "        &ROT_OPT #How to optimizing dimer rotation"
            write(ifileid,"(a)") "          OPTIMIZER CG"
            write(ifileid,"(a)") "          MAX_ITER 50 #Maximum number of optimization steps, default is 200"
            write(ifileid,"(a)") "          #The following thresholds of dimer orientation are the default ones"
            write(ifileid,"(a)") "          MAX_DR 3E-3 #Maximum geometry change"
            write(ifileid,"(a)") "          RMS_DR 1.5E-3 #RMS geometry change"
            write(ifileid,"(a)") "          MAX_FORCE 4.5E-4 #Maximum force"
            write(ifileid,"(a)") "          RMS_FORCE 3E-4 #RMS force"
            write(ifileid,"(a)") "          &CG"
            write(ifileid,"(a)") "            &LINE_SEARCH"
            write(ifileid,"(a)") "              TYPE 2PNT"
            write(ifileid,"(a)") "            &END LINE_SEARCH"
            write(ifileid,"(a)") "          &END CG"
            write(ifileid,"(a)") "        &END ROT_OPT"
            write(ifileid,"(a)") "      &END DIMER"
            write(ifileid,"(a)") "    &END TRANSITION_STATE"
        end if
        write(ifileid,"(a)") "    MAX_ITER 250 #Maximum number of geometry optimization"
        write(ifileid,"(a)") "    #The following thresholds of geometry convergence are the default ones"
        write(ifileid,"(a)") "    MAX_DR 3E-3 #Maximum geometry change"
        write(ifileid,"(a)") "    RMS_DR 1.5E-3 #RMS geometry change"
        write(ifileid,"(a)") "    MAX_FORCE 4.5E-4 #Maximum force"
        write(ifileid,"(a)") "    RMS_FORCE 3E-4 #RMS force"
        write(ifileid,"(a)") "  &END GEO_OPT"
    else if (itask==4) then
        write(ifileid,"(a)") "  &CELL_OPT"
        write(ifileid,"(a)") "    MAX_ITER 250 #Maximum number of geometry optimization"
        write(ifileid,"(a)") "    EXTERNAL_PRESSURE 1.01325 #External pressure for cell optimization (bar)" !Full 9 components of the pressure tensor can be individually specified
        write(ifileid,"(a)") "    CONSTRAINT NONE #Can be e.g. Z, XY to fix corresponding cell length"
        write(ifileid,"(a)") "    KEEP_ANGLES F #If T, then cell angles will be kepted"
        write(ifileid,"(a)") "    KEEP_SYMMETRY F #If T, crystal symmetry will be kepted, and symmetry should be specified in &CELL"
        write(ifileid,"(a)") "    TYPE DIRECT_CELL_OPT #Geometry and cell are optimized at the same time. Can also be GEO_OPT, MD"
        write(ifileid,"(a)") "    #The following thresholds of optimization convergence are the default ones"
        write(ifileid,"(a)") "    MAX_DR 3E-3 #Maximum geometry change"
        write(ifileid,"(a)") "    RMS_DR 1.5E-3 #RMS geometry change"
        write(ifileid,"(a)") "    MAX_FORCE 4.5E-4 #Maximum force"
        write(ifileid,"(a)") "    RMS_FORCE 3E-4 #RMS force"
        write(ifileid,"(a)") "    PRESSURE_TOLERANCE 100 #Pressure tolerance (w.r.t EXTERNAL_PRESSURE)"
        if (ioptmethod==1) then
            write(ifileid,"(a)") "    OPTIMIZER BFGS #Can also be CG (more robust for difficult cases) or LBFGS"
            write(ifileid,"(a)") "    &BFGS"
            write(ifileid,"(a)") "      TRUST_RADIUS 0.2 #Trust radius (maximum stepsize) in Angstrom"
            write(ifileid,"(a)") "#     RESTART_HESSIAN T #If read initial Hessian, uncomment this line and specify the file in the next line"
            write(ifileid,"(a)") "#     RESTART_FILE_NAME to_be_specified"
            write(ifileid,"(a)") "    &END BFGS"
        else if (ioptmethod==2) then
            write(ifileid,"(a)") "    OPTIMIZER LBFGS #Can also be CG (more robust for difficult cases) or BFGS"
        else if (ioptmethod==3) then
            write(ifileid,"(a)") "    OPTIMIZER CG #Can also be BFGS or LBFGS"
            write(ifileid,"(a)") "    &CG"
            write(ifileid,"(a)") "      &LINE_SEARCH"
            write(ifileid,"(a)") "        TYPE 2PNT #Two-point extrapolation, cheap while acceptable. Can also be FIT, GOLD"
            write(ifileid,"(a)") "      &END LINE_SEARCH"
            write(ifileid,"(a)") "    &END CG"
        end if
        write(ifileid,"(a)") "  &END CELL_OPT"
    else if (itask==6) then !MD
        write(ifileid,"(a)") "  &MD"
        if (ithermostat==0.and.ibarostat==0) then
            write(ifileid,"(a)") "    ENSEMBLE NVE"
        else if (ithermostat>1.and.ibarostat==0) then
            write(ifileid,"(a)") "    ENSEMBLE NVT"
        else if (ithermostat==0) then
            if (ibarostat==1) write(ifileid,"(a)") "    ENSEMBLE NPE_F"
            if (ibarostat==2) write(ifileid,"(a)") "    ENSEMBLE NPE_I"
        else if (ithermostat>1) then
            if (ibarostat==1) write(ifileid,"(a)") "    ENSEMBLE NPT_F"
            if (ibarostat==2) write(ifileid,"(a)") "    ENSEMBLE NPT_I"
        end if
        write(ifileid,"(a)") "    STEPS 200"
        write(ifileid,"(a)") "    TIMESTEP 1.0 #fs. Decrease it properly for high temperature simulation"
        write(ifileid,"(a)") "    TEMPERATURE 298.15 #Initial and maintained temperature (K)"
        if (ithermostat>0) then
            write(ifileid,"(a)") "    &THERMOSTAT"
            if (ithermostat==1) write(ifileid,"(a)") "      TYPE AD_LANGEVIN"
            if (ithermostat==2) then
                write(ifileid,"(a)") "      TYPE CSVR"
                write(ifileid,"(a)") "      &CSVR"
                write(ifileid,"(a)") "        TIMECON 200 #Time constant in fs. Smaller/larger results in stronger/weaker temperature coupling"
                write(ifileid,"(a)") "      &END CSVR"
            end if
            if (ithermostat==3) write(ifileid,"(a)") "      TYPE GLE"
            if (ithermostat==4) write(ifileid,"(a)") "      TYPE NOSE"
            if (nthermoatm<ncenter) then
                write(ifileid,"(a)") "      &DEFINE_REGION"
                call testidx_contiguous(thermoatm,nthermoatm,ifconti)
                if (ifconti==1) then
                    write(c80tmp,*) maxval(thermoatm(1:nthermoatm))
                    write(ifileid,"(a,i8,'..',a)") "        LIST ",minval(thermoatm(1:nthermoatm)),adjustl(c80tmp)
                else
                    write(ifileid,"(a)",advance='no') "        LIST "
                    icount=0
                    do iatm=1,nthermoatm
                        write(ifileid,"(i6)",advance="no") thermoatm(iatm)
                        icount=icount+1
                        if (iatm==nthermoatm) then
                            write(ifileid,*)
                        else
                            if (icount==6) then
                                icount=0
                                write(ifileid,"(a)") " \"
                                write(ifileid,"(a)",advance="no") "             "
                            end if
                        end if
                    end do
                end if
                write(ifileid,"(a)") "      &END DEFINE_REGION"
            end if
            write(ifileid,"(a)") "    &END THERMOSTAT"
        end if
        if (ibarostat/=0) then
            write(ifileid,"(a)") "    &BAROSTAT"
            write(ifileid,"(a)") "      PRESSURE 1.01325 #Initial and maintained pressure (bar)"
            write(ifileid,"(a)") "      VIRIAL XYZ #Relax the cell along which cartesian axes"
            write(ifileid,"(a)") "    &END BAROSTAT"
        end if
        write(ifileid,"(a)") "  &END MD"
    end if
    if (natmcons>0) then
        write(ifileid,"(a)") "  &CONSTRAINT"
        write(ifileid,"(a)") "    &FIXED_ATOMS #Set atoms to be fixed"
        write(ifileid,"(a)") "      COMPONENTS_TO_FIX XYZ #May also be e.g. Z, XY ..."
        call testidx_contiguous(atmcons,natmcons,ifconti)
        if (ifconti==1) then
            write(c80tmp,*) maxval(atmcons(1:natmcons))
            write(ifileid,"(a,i8,'..',a)") "      LIST ",minval(atmcons(1:natmcons)),adjustl(c80tmp)
        else
            write(ifileid,"(a)",advance='no') "      LIST "
            i=0
            do while(.true.)
                if (i*12<natmcons-12) then
                    write(ifileid,"(12i6,' \')") atmcons(12*i+1:12*i+12)
                    i=i+1
                else
                    write(ifileid,"(12i6)") atmcons(12*i+1:natmcons)
                    exit
                end if
            end do
        end if
        write(ifileid,"(a)") "    &END FIXED_ATOMS"
        write(ifileid,"(a)") "  &END CONSTRAINT"
    end if

    !Output frequency of various properties
    write(ifileid,"(a)") "  &PRINT"
    if (itask==6) then
        write(ifileid,"(a)") "    &TRAJECTORY"
        write(ifileid,"(a)") "      &EACH"
        write(ifileid,"(a,i6,a)") "        MD",nMDsavefreq," #Output frequency of geometry"
        write(ifileid,"(a)") "      &END EACH"
        if (iMDformat==1) write(ifileid,"(a)") "      FORMAT xyz"
        if (iMDformat==2) write(ifileid,"(a)") "      FORMAT dcd"
        if (iMDformat==3) write(ifileid,"(a)") "      FORMAT pdb"
        write(ifileid,"(a)") "    &END TRAJECTORY"
        write(ifileid,"(a)") "    &VELOCITIES"
        write(ifileid,"(a)") "      &EACH"
        write(ifileid,"(a,i6,a)") "        MD",nMDsavefreq," #Output frequency of velocity"
        write(ifileid,"(a)") "      &END EACH"
        write(ifileid,"(a)") "    &END VELOCITIES"
    end if

    write(ifileid,"(a)") "    &RESTART"
    write(ifileid,"(a)") "      BACKUP_COPIES 0 #Maximum number of backing up restart file" !Do not generate annoying .restart.bak file
    if (itask==6) then !Update restart file every 10 steps
        write(ifileid,"(a)") "      &EACH"
        write(ifileid,"(a)") "        MD 10 #Frequency of updating last restart file"
        write(ifileid,"(a)") "      &END EACH"
    end if
    write(ifileid,"(a)") "    &END RESTART"

    if (itask==4) then !Avoid generating a batch of history .restart files at every step
        write(ifileid,"(a)") "    &RESTART_HISTORY" !Rarely needed. Default is output every 500 steps
        write(ifileid,"(a)") "      &EACH"
        write(ifileid,"(a)") "        CELL_OPT 0 #How often a history .restart file is generated, 0 means never"
        write(ifileid,"(a)") "      &END EACH"
        write(ifileid,"(a)") "    &END RESTART_HISTORY"
    else if (itask==6) then !Rarely needed. Default is outputting every 500 steps
        !write(ifileid,"(a)") "    &RESTART_HISTORY"
        !write(ifileid,"(a)") "      &EACH"
        !write(ifileid,"(a)") "        MD 100 #How often a history .restart file is generated"
        !write(ifileid,"(a)") "      &END EACH"
        !write(ifileid,"(a)") "    &END RESTART_HISTORY"
    end if
    write(ifileid,"(a)") "  &END PRINT"
    write(ifileid,"(a)") "&END MOTION"
end if
if (itask==5) then
    write(ifileid,"(a)") "&VIBRATIONAL_ANALYSIS"
    write(ifileid,"(a)") "  DX 0.01 #Step size of finite difference. This is default (Bohr)"
    write(ifileid,"(a)") "  NPROC_REP 1 #Number of processors to be used per replica. This is default"
    write(ifileid,"(a)") "  TC_PRESSURE 101325 #1 atm. Pressure for calculate thermodynamic data (Pa)"
    write(ifileid,"(a)") "  TC_TEMPERATURE 298.15 #Temperature for calculate thermodynamic data (K)"
    write(ifileid,"(a)") "  THERMOCHEMISTRY #Print thermochemistry information (only correct for gas molecule!)"
    write(ifileid,"(a)") "  INTENSITIES T #Calculate IR intensities"
    if (ioutvibmol==1) then
        write(ifileid,"(a)") "  &PRINT"
        write(ifileid,"(a)") "    &MOLDEN_VIB #Output .mol (Molden file) for visualization vibrational modes"
        write(ifileid,"(a)") "    &END MOLDEN_VIB"
        write(ifileid,"(a)") "  &END PRINT"
    end if
    write(ifileid,"(a)") "&END VIBRATIONAL_ANALYSIS"
end if

close(ifileid)

write(*,"(a)") " CP2K input file has been exported to "//trim(outname)
end subroutine

!----- Test if a given integer array contains contiguous numbers (index order is unimportant)
!If yes, ifconti=1, else =0
subroutine testidx_contiguous(array,narray,ifconti)
implicit real*8 (a-h,o-z)
integer narray,array(narray)
ifconti=0
do i=minval(array),maxval(array)
    if (all(array/=i)) return
end do
ifconti=1
end subroutine

!!---------- Interface of outputting Quantum ESPRESSO input file
subroutine outQEinp_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for generating Quantum ESPRESSO input file, e.g. C:\ltwd.inp"
write(*,"(a)") " If press ENTER button directly, will export to "//trim(c200tmp)//".inp"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".inp"
call outQEinp(outname,10)
end subroutine
!!---------- Output current coordinate to Quantum ESPRESSO input file
subroutine outQEinp(outname,ifileid)
use defvar
use util
character(len=*) outname
integer ifileid,eleidx(ncenter)
character c80tmp*80,c200tmp*200,c2000tmp*2000

!Count number of elements
nele=1
eleidx(1)=a(1)%index
do iatm=2,ncenter
    if (all(eleidx(:nele)/=a(iatm)%index)) then
        nele=nele+1
        eleidx(nele)=a(iatm)%index
    end if
end do

open(ifileid,file=outname,status="replace")
call path2filename(filename,c200tmp)
write(ifileid,"(a)") "&control"
write(ifileid,"(a)") " calculation= 'scf'"
write(ifileid,"(a)") " prefix= '"//trim(c200tmp)//"'"
write(ifileid,"(a)") " pseudo_dir= './'"
write(ifileid,"(a)") "/"
write(ifileid,"(a)") "&system"
write(ifileid,"(a)") " ibrav= 0"
write(ifileid,"(a,i6)") " nat=",ncenter
write(ifileid,"(a,i5)") " ntyp=",nele
write(ifileid,"(a)") " ecutwfc= 44.0"
write(ifileid,"(a)") "/"

write(ifileid,"(a)") "&electrons"
write(ifileid,"(a)") "/"
write(ifileid,"(a)") "CELL_PARAMETERS angstrom"
write(ifileid,"(3f14.8)") cellv1(:)*b2a
write(ifileid,"(3f14.8)") cellv2(:)*b2a
write(ifileid,"(3f14.8)") cellv3(:)*b2a
write(ifileid,"(a)") "ATOMIC_SPECIES"
do itype=1,nele
    write(ifileid,"(a,f9.4,a)") ind2name(eleidx(itype)),atmwei(eleidx(itype)),"  Pseudopotential_file"
end do
write(ifileid,"(a)") "ATOMIC_POSITIONS angstrom"
do iatm=1,ncenter
    write(ifileid,"(a,3f12.6)") a(iatm)%name,a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
end do
write(ifileid,"(a)") "K_POINTS automatic"
write(ifileid,"(a)") "3 3 3 0 0 0"

close(ifileid)

write(*,"(a)") " Quantum ESPRESSO input file has been exported to "//trim(outname)//", you need to manually set proper pseudopotential file"
if (ifPBC==0) write(*,"(a)") " Warning: Since the file loaded when Multiwfn booted up does not contain cell information, &
all cell vectors in the created input file are set to be 0!"
end subroutine

!!---------- Interface of outputting VASP POSCAR file
subroutine outPOSCAR_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for generating VASP POSCAR file, e.g. C:\ltwd.poscar"
write(*,"(a)") " If press ENTER button directly, will export to POSCAR in current folder"
read(*,"(a)") outname
if (outname==" ") outname="POSCAR"
call outPOSCAR(outname,10)
end subroutine
!!---------- Output current coordinate to VASP position file POSCAR
subroutine outPOSCAR(outname,ifileid)
use defvar
use util
character(len=*) outname
integer ifileid,natmele(nelesupp)
character c80tmp*80,c200tmp*200,c2000tmp*2000
real*8 fract(3),Cart(3)

call path2filename(filename,c200tmp)
open(ifileid,file=outname,status="replace")
write(ifileid,"(a)") trim(c200tmp)//"; Created by Multiwfn"
write(ifileid,"(a)") "1.0"
write(ifileid,"(3f16.8)") cellv1*b2a
write(ifileid,"(3f16.8)") cellv2*b2a
write(ifileid,"(3f16.8)") cellv3*b2a
!Count how many atoms corresponding to each element
do iele=1,nelesupp
    natmele(iele)=count(a%index==iele)
end do
!Write element names
do iele=1,nelesupp
    if (natmele(iele)/=0) write(ifileid,"(a6)",advance="no") ind2name(iele)
end do
write(ifileid,*)
!Write number of atoms of each element
do iele=1,nelesupp
   if (natmele(iele)/=0) write(ifileid,"(i6)",advance="no") natmele(iele)
end do
write(ifileid,*)
write(ifileid,"(a)") "Direct"
!Write fractional atom coordinates
do iele=1,nelesupp
    do iatm=1,ncenter
        if (a(iatm)%index==iele) then
            Cart(1)=a(iatm)%x
            Cart(2)=a(iatm)%y
            Cart(3)=a(iatm)%z
            call Cart2fract(Cart,fract)
            write(ifileid,"(3f16.8)") fract(:)
        end if
    end do
end do
close(ifileid)

write(*,"(a)") " VASP POSCAR file has been exported to "//trim(outname)//" in current folder"
if (ifPBC==0) write(*,"(a)") " Warning: Since the file loaded when Multiwfn booted up does not contain cell information, &
all cell vectors in the created POSCAR file are set to be 0, and fractional coordinates are all zero!"
end subroutine

!!---------- Interface of outputting Gaussian-type .cub file
subroutine outcube_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path of the new cube file, e.g. C:\Tree.cub"
write(*,"(a)") " If press ENTER button directly, will be exported to "//trim(c200tmp)//".cub"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".cub"
write(*,*) "Exporting, please wait..."
open(10,file=outname,status="replace")
call outcube(cubmat,nx,ny,nz,orgx,orgy,orgz,gridv1,gridv2,gridv3,10)
close(10)
write(*,*) "Done, cube file has been outputted"
end subroutine
!!-------- Output 3D matrix with property to a cube file. fileid must be opened before invoking this routine, and close it after that
!Example of calling: outcube(holegrid,nx,ny,nz,orgx,orgy,orgz,gridv1,gridv2,gridv3,10)
subroutine outcube(matrix,numx,numy,numz,org_x,org_y,org_z,trans1,trans2,trans3,fileid)
use defvar
implicit real*8 (a-h,o-z)
integer numx,numy,numz,fileid
real*8 org_x,org_y,org_z,trans1(3),trans2(3),trans3(3)
real*8 matrix(numx,numy,numz)

write(fileid,"(' Generated by Multiwfn')")
write(fileid,"(' Totally ',i12,' grid points')") numx*numy*numz
if (ncenter>=1) then
	write(fileid,"(i5,3f12.6)") ncenter,org_x,org_y,org_z
else
	write(fileid,"(i5,3f12.6)") 1,org_x,org_y,org_z
end if
write(fileid,"(i5,3f12.6)") numx,trans1
write(fileid,"(i5,3f12.6)") numy,trans2
write(fileid,"(i5,3f12.6)") numz,trans3
if (ncenter>=1) then
	do i=1,ncenter
		write(fileid,"(i5,4f12.6)") a(i)%index,a(i)%charge,a(i)%x,a(i)%y,a(i)%z
	end do
else
	write(*,"(a)") " Note: Current system has no atom, in order to maximize compatibility of the generated .cub file, a hydrogen atom is added to 0,0,0"
	write(*,*)
	write(fileid,"(i5,4f12.6)") 1,1D0,0D0,0D0,0D0
end if
where (abs(matrix)<=1D-99) matrix=0D0 !Diminish too small value, otherwise the symbol "E" cannot be shown by 1PE13.5 format e.g. 9.39376-116
!write(*,*) "Exporting cube file, please wait..."
do i=1,numx
	do j=1,numy
		write(fileid,"(6(1PE14.5E3))",advance="no") matrix(i,j,1:numz)
		write(fileid,*)
	end do
end do
end subroutine

!!!------------- Output grid data to .vti file, which can be visualized by ParaView
subroutine outvti(outvtiname,ifileid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) outvtiname
character outcmlname*200,selectyn
open(ifileid,file=outvtiname,status="replace")
write(ifileid,"(a)") '<?xml version="1.0"?>'
write(ifileid,"(a)") ' <VTKFile type="ImageData" version="0.1" byte_order="LittleEndian">'
write(ifileid,"(a,6i5,a,3f12.6,a,3f12.6,a)") '  <ImageData WholeExtent="',0,nx-1,0,ny-1,0,nz-1,' " Origin="',&
orgx,orgy,orgz,' " Spacing="',gridv1(1),gridv2(2),gridv3(3),' ">'
write(ifileid,"(a,6i5,a)") '  <Piece Extent="',0,nx-1,0,ny-1,0,nz-1,' ">'
write(ifileid,"(a)") '  <PointData Scalars="scalars">'
write(ifileid,"(a)") '  <DataArray Name="scalars" type="Float64" NumberOfComponents="1" Format="ascii">'
write(ifileid,"(4E14.6)") (((cubmat(i,j,k),i=1,nx),j=1,ny),k=1,nz)
write(ifileid,"(a)") '    </DataArray>'
write(ifileid,"(a)") '    </PointData>'
write(ifileid,"(a)") '    </Piece>'
write(ifileid,"(a)") '    </ImageData>'
write(ifileid,"(a)") ' </VTKFile>'
close(ifileid)
write(*,*) "Exporting vti file finished!"
write(*,*)
write(*,"(a)") " Do you also want to export .cml file in Bohr, so that you can visualize grid data as well as molecular structure in ParaView? (y/n)"
read(*,*) selectyn
if (selectyn=='y') then
    write(*,*) "Input path of .cml file, e.g. C:\aqours.cml"
    read(*,"(a)") outcmlname
    call outcml(outcmlname,ifileid,1)
end if
end subroutine

!!!--------------------- Output current wavefunction to a .wfn
!If isortatmind==1, then any atom without GTF posited on it will not be output, and the index is filled to assure contiguous
!Orbitals with zero occupiation will not be outputted
!If ioutinfo==1, output information
subroutine outwfn(outwfnname,isortatmind,ioutinfo,ifileid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) outwfnname
integer isortatmind,ioutinfo,ifileid,indconv(ncenter)
!convGmul2wfn converts the g sequence used internally in Multiwfn (input) to commonly used g sequence in .wfn (the one outputted by Molden2AIM and g09 since B01 )
integer :: convGmul2wfn(35)=(/ (0,i=1,20), 23,29,32,27,22, 28,35,34,26,31, 33,30,25,24,21 /)
integer :: convGwfn2mul(35)=(/ (0,i=1,20), 35,25,21,34,33, 29,24,26,22,32, 30,23,31,28,27 /)

open(ifileid,file=outwfnname,status="replace")
write(ifileid,*) "Generated by Multiwfn"

if (isortatmind==1) then !Find real number of centers
	j=0
	do i=1,ncenter
		if (any(b%center==i)) j=j+1
	end do
	write(ifileid,"('GAUSSIAN',i15,' MOL ORBITALS',i7,' PRIMITIVES',i9,' NUCLEI')") count(MOocc(1:nmo)/=0D0),nprims,j
else
	write(ifileid,"('GAUSSIAN',i15,' MOL ORBITALS',i7,' PRIMITIVES',i9,' NUCLEI')") count(MOocc(1:nmo)/=0D0),nprims,ncenter
end if

j=1
do i=1,ncenter
	if (isortatmind==1) then
		if (all(b%center/=i)) cycle
	end if
	indconv(j)=i !The j actual atom corresponds to the i original atom
	write(ifileid,"(2x,a2,i4,4x,'(CENTRE',i3,')',1x,3f12.8,'  CHARGE =',f5.1)") a(i)%name,j,j,a(i)%x,a(i)%y,a(i)%z,a(i)%charge
	j=j+1
end do

if (isortatmind==1) then !Convert center of GTF to reordered index
	do i=1,j-1 !Cycle the centers with GTF
		where(b%center==indconv(i)) b%center=i
	end do
end if

write(ifileid,"('CENTRE ASSIGNMENTS  ',20i3)") b(1:nprims)%center

!Convert the g sequence to common sequence in .wfn, output them, and then convert back. This make output easier
do i=1,nprims
	if (b(i)%type>=21.and.b(i)%type<=35) b(i)%type=convGmul2wfn(b(i)%type)
end do
write(ifileid,"('TYPE ASSIGNMENTS    ',20i3)") b%type
do i=1,nprims
	if (b(i)%type>=21.and.b(i)%type<=35) b(i)%type=convGwfn2mul(b(i)%type)
end do

write(ifileid,"('EXPONENTS ',5D14.7)") b%exp
imo=0
nzeroocc=0
do i=1,nmo
	if (MOocc(i)==0D0) then
		nzeroocc=nzeroocc+1
		cycle
	end if
	imo=imo+1 !Use imo instead of i, this can make MO index contiguous
	write(ifileid,"('MO',I5,'     MO 0.0        OCC NO = ',f12.7,'  ORB. ENERGY =', f12.6)") imo,MOocc(i),MOene(i)
	write(ifileid,"(5D16.8)") (CO(i,j),j=1,nprims)
end do
write(ifileid,"('END DATA',/,' THE  HF ENERGY = ',f19.12,' THE VIRIAL(-V/T)= ',f12.8)") totenergy,virialratio
if (ifPBC>0) then
    write(ifileid,"(/,a)") "[Cell]"
    write(ifileid,"(3f12.6)") cellv1(:)*b2a
    if (ifPBC>=2) write(ifileid,"(3f12.6)") cellv2(:)*b2a
    if (ifPBC==3) write(ifileid,"(3f12.6)") cellv3(:)*b2a
end if
close(ifileid)
if (nzeroocc>0.and.ioutinfo==1) write(*,"(a,i10,a)") " Note: Found",nzeroocc," zero occupied orbitals and have discarded them"
end subroutine

!!!----------------- Output current wavefunction to a .wfx file
!Orbitals with zero occupiation will not be outputted
!If ioutinfo==1, output information
subroutine outwfx(outwfxname,ioutinfo,ifileid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) outwfxname
character c10tmp*10
integer ioutinfo,ifileid,indconv(ncenter)
! convGseq is used to convert g used in internal sequence of Multiwfn to .wfx sequence
! PS: spdfh sequence in .wfx is identical to Multiwfn
integer :: convGseq(35)
convGseq(21:35)=(/ 23,29,32,27,22,28,35,34,26,31,33,30,25,24,21 /) !g 21~35

nzeroocc=count(MOocc==0D0)
open(ifileid,file=outwfxname,status="replace")
write(ifileid,"(a)") "<Title>"
write(ifileid,*) "Generated by Multiwfn"
write(ifileid,"(a)") "</Title>"
write(ifileid,"(a)") "<Keywords>"
write(ifileid,"(a)") " GTO"
write(ifileid,"(a)") "</Keywords>"
write(ifileid,"(a)") "<Number of Nuclei>"
write(ifileid,"(i6)") ncenter
write(ifileid,"(a)") "</Number of Nuclei>"
write(ifileid,"(a)") "<Number of Occupied Molecular Orbitals>"
write(ifileid,"(i6)") nmo-nzeroocc
write(ifileid,"(a)") "</Number of Occupied Molecular Orbitals>"
write(ifileid,"(a)") "<Number of Perturbations>"
write(ifileid,"(i6)") 0
write(ifileid,"(a)") "</Number of Perturbations>"
write(ifileid,"(a)") "<Net Charge>"
write(ifileid,"(i6)") sum(a%charge)-nint(nelec)
write(ifileid,"(a)") "</Net Charge>"
write(ifileid,"(a)") "<Number of Electrons>"
write(ifileid,"(i6)") nint(nelec)
write(ifileid,"(a)") "</Number of Electrons>"
write(ifileid,"(a)") "<Number of Alpha Electrons>"
write(ifileid,"(i6)") nint(naelec)
write(ifileid,"(a)") "</Number of Alpha Electrons>"
write(ifileid,"(a)") "<Number of Beta Electrons>"
write(ifileid,"(i6)") nint(nbelec)
write(ifileid,"(a)") "</Number of Beta Electrons>"
write(ifileid,"(a)") "<Electronic Spin Multiplicity>"
write(ifileid,"(i6)") nint(naelec-nbelec)+1
write(ifileid,"(a)") "</Electronic Spin Multiplicity>"
write(ifileid,"(a)") "<Number of Core Electrons>"
write(ifileid,"(i6)") nEDFelec
write(ifileid,"(a)") "</Number of Core Electrons>"
write(ifileid,"(a)") "<Nuclear Names>"
do iatm=1,ncenter
	write(c10tmp,"(i6)") iatm
	write(ifileid,"(1x,a)") trim(a(iatm)%name)//trim(adjustl(c10tmp))
end do
write(ifileid,"(a)") "</Nuclear Names>"
write(ifileid,"(a)") "<Atomic Numbers>"
do iatm=1,ncenter
	write(ifileid,"(i3)") a(iatm)%index
end do
write(ifileid,"(a)") "</Atomic Numbers>"
write(ifileid,"(a)") "<Nuclear Charges>"
do iatm=1,ncenter
	write(ifileid,"(E20.12)") a(iatm)%charge
end do
write(ifileid,"(a)") "</Nuclear Charges>"
write(ifileid,"(a)") "<Nuclear Cartesian Coordinates>"
do iatm=1,ncenter
	write(ifileid,"(3E20.12)") a(iatm)%x,a(iatm)%y,a(iatm)%z
end do
write(ifileid,"(a)") "</Nuclear Cartesian Coordinates>"
write(ifileid,"(a)") "<Number of Primitives>"
write(ifileid,"(i6)") nprims
write(ifileid,"(a)") "</Number of Primitives>"
write(ifileid,"(a)") "<Primitive Centers>"
write(ifileid,"(5i20)") b%center
write(ifileid,"(a)") "</Primitive Centers>"
write(ifileid,"(a)") "<Primitive Types>"
icount=0
do iprim=1,nprims
	if (b(iprim)%type>=21.and.b(iprim)%type<=35) then
		write(ifileid,"(i20)",advance="no") convGseq(b(iprim)%type)
	else
		write(ifileid,"(i20)",advance="no") b(iprim)%type
	end if
	icount=icount+1
	if (icount==5.or.iprim==nprims) then
		write(ifileid,*)
		icount=0
	end if
end do
write(ifileid,"(a)") "</Primitive Types>"
write(ifileid,"(a)") "<Primitive Exponents>"
write(ifileid,"(5E20.12)") b%exp
write(ifileid,"(a)") "</Primitive Exponents>"
if (allocated(b_EDF)) then
	write(ifileid,"(a)") "<Additional Electron Density Function (EDF)>"
	write(ifileid,"(a)") "<Number of EDF Primitives>"
	write(ifileid,"(i6)") nEDFprims
	write(ifileid,"(a)") "</Number of EDF Primitives>"
	write(ifileid,"(a)") "<EDF Primitive Centers>"
	write(ifileid,"(5i20)") b_EDF%center
	write(ifileid,"(a)") "</EDF Primitive Centers>"
	write(ifileid,"(a)") "<EDF Primitive Types>"
	write(ifileid,"(5i20)") b_EDF%type
	write(ifileid,"(a)") "</EDF Primitive Types>"
	write(ifileid,"(a)") "<EDF Primitive Exponents>"
	write(ifileid,"(5E20.12)") b_EDF%exp
	write(ifileid,"(a)") "</EDF Primitive Exponents>"
	write(ifileid,"(a)") "<EDF Primitive Coefficients>"
	write(ifileid,"(5E20.12)") CO_EDF
	write(ifileid,"(a)") "</EDF Primitive Coefficients>"
	write(ifileid,"(a)") "</Additional Electron Density Function (EDF)>"
end if

write(ifileid,"(a)") "<Molecular Orbital Occupation Numbers>"
do imo=1,nmo
	if (MOocc(imo)/=0D0) write(ifileid,"(E20.12)") MOocc(imo)
end do
write(ifileid,"(a)") "</Molecular Orbital Occupation Numbers>"

write(ifileid,"(a)") "<Molecular Orbital Energies>"
do imo=1,nmo
	if (MOocc(imo)/=0D0) write(ifileid,"(E20.12)") MOene(imo)
end do
write(ifileid,"(a)") "</Molecular Orbital Energies>"

write(ifileid,"(a)") "<Molecular Orbital Spin Types>"
do imo=1,nmo
	if (MOocc(imo)/=0D0) then
		if (MOtype(imo)==0) write(ifileid,"(a)") " Alpha and Beta"
		if (MOtype(imo)==1) write(ifileid,"(a)") " Alpha"
		if (MOtype(imo)==2) write(ifileid,"(a)") " Beta"
	end if
end do
write(ifileid,"(a)") "</Molecular Orbital Spin Types>"

write(ifileid,"(a)") "<Molecular Orbital Primitive Coefficients>"
i=0
nzeroocc=0
do imo=1,nmo
	if (MOocc(imo)==0D0) cycle
	i=i+1 !Use i instead of imo, this can make MO index contiguous
	write(ifileid,"(a)") "<MO Number>"
	write(ifileid,"(i6)") i
	write(ifileid,"(a)") "</MO Number>"
	write(ifileid,"(4E20.12)") CO(imo,:)
end do
write(ifileid,"(a)") "</Molecular Orbital Primitive Coefficients>"

write(ifileid,"(a)") "<Energy = T + Vne + Vee + Vnn>"
write(ifileid,"(E20.12)") totenergy
write(ifileid,"(a)") "</Energy = T + Vne + Vee + Vnn>"

write(ifileid,"(a)") "<Virial Ratio (-V/T)>"
write(ifileid,"(E20.12)") virialratio
write(ifileid,"(a)") "</Virial Ratio (-V/T)>"

close(ifileid)
if (nzeroocc>0.and.ioutinfo==1) write(*,"(a,i10,a)") " Note: Found",nzeroocc," zero occupied orbitals and have discarded them"
end subroutine

!!--------------- Interface of outputting .molden file
subroutine outmolden_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for generating .molden file, e.g. C:\sunshine\riko.molden"
write(*,"(a)") " If press ENTER button directly, will be exported to "//trim(c200tmp)//".molden"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".molden"
write(*,*) "Exporting, please wait..."
call outmolden(outname,10)
write(*,*) "Exporting Molden input file finished!"
end subroutine
!!!------------------------- Output current wavefunction to Molden input file
subroutine outmolden(outname,ifileid)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) outname
integer ifileid
character symbol,nowdate*20,nowtime*20

open(ifileid,file=outname,status="replace")
write(ifileid,"(a)") "[Molden Format]"
if (ifPBC>0) then
    write(ifileid,"(a)") "[Cell]"
    write(ifileid,"(3f12.6)") cellv1(:)*b2a
    if (ifPBC>=2) write(ifileid,"(3f12.6)") cellv2(:)*b2a
    if (ifPBC==3) write(ifileid,"(3f12.6)") cellv3(:)*b2a
end if
write(ifileid,"(a)") "[Title]"
call date_and_time(nowdate,nowtime)
write(ifileid,"(a,'  Date: ',a,'-',a,'-',a,' Time: ',a,':',a,':',a)") "Generated by Multiwfn",nowdate(1:4),nowdate(5:6),nowdate(7:8),nowtime(1:2),nowtime(3:4),nowtime(5:6)
write(ifileid,"(a)") "[Atoms] AU"
do i=1,ncenter
	write(ifileid,"(a,i7,i4,3f14.7)") a(i)%name,i,a(i)%index,a(i)%x,a(i)%y,a(i)%z
end do
write(ifileid,"(a)") "[GTO]"
do iatm=1,ncenter
	write(ifileid,"(2i6)") iatm,0
	do ish=1,nshell
		if (shcen(ish)==iatm) then
			symbol=shtype2name(shtype(ish))
			call struc2lc(symbol)
			write(ifileid,"(a,i4,' 1.0')") symbol,shcon(ish)
			if (ish==0) then
				istart=0
			else
				istart=sum(shcon(1:ish-1))
			end if
			do ipsh=istart+1,istart+shcon(ish)
				write(ifileid,"(2(1PE16.8))") primshexp(ipsh),primshcoeff(ipsh)
			end do
		end if
	end do
	write(ifileid,*)
end do
write(ifileid,*)

if (any(shtype==-2).and.any(shtype==-3)) then !Default is 6d10f
	write(ifileid,"('[5D]')") !5d7f
else if (any(shtype==-2)) then
	write(ifileid,"('[5D10F]')") !5d10f
else if (any(shtype==-3)) then
	write(ifileid,"('[7F]')") !=6d7f
end if
if (any(shtype==-4)) write(ifileid,"('[9G]')") !Default is Cartesian G
if (any(shtype==-5)) write(ifileid,"('[11H]')") !Default is Cartesian H
write(ifileid,"(a)") "[MO]"
if (wfntype==0.or.wfntype==2.or.wfntype==3) then !Close shell
	do imo=1,nmo
		write(ifileid,"('Ene=',f16.8)") MOene(imo)
		write(ifileid,"('Spin= Alpha')")
		write(ifileid,"('Occup=',f10.6)") MOocc(imo)
		do ibas=1,nbasis
			write(ifileid,"(i6,f18.10)") ibas,CObasa(ibas,imo)
		end do
	end do
else !Open shell
	do isep=nmo,1,-1
		if (MOtype(isep)==1) exit
	end do
	do imo=1,isep !Alpha part
		write(ifileid,"('Ene=',f16.8)") MOene(imo)
		write(ifileid,"('Spin= Alpha')")
		write(ifileid,"('Occup=',f10.6)") MOocc(imo)
		do ibas=1,nbasis
			write(ifileid,"(i6,f18.10)") ibas,CObasa(ibas,imo)
		end do
	end do
	do imo=isep+1,nmo !Beta part
		write(ifileid,"('Ene=',f16.8)") MOene(imo)
		write(ifileid,"('Spin= Beta')")
		write(ifileid,"('Occup=',f10.6)") MOocc(imo)
		do ibas=1,nbasis
			write(ifileid,"(i6,f18.10)") ibas,CObasb(ibas,imo-isep)
		end do
	end do
end if

close(ifileid)
end subroutine

!!!--------------- Output current wavefunction to mkl file (old Molekel input file), then orca_2mkl can convert it to .gbw
!The format is exactly identical to the .mkl file produced by orca_2mkl (e.g. orca_2mkl test can generate test.mkl from test.gbw)
!Note that when if the gbw file converted from .mkl is used as initial guess, the number of orbitals recorded in the .mkl can be &
!smaller than number of basis functions. The only important point is that all occupied orbitals are recorded. The virtual orbitals &
!can be ignored in the .mkl, the coefficients can also be all zero. Therefore, when exporting .mkl file, it is not necessary to check &
!if the final several orbitals have all zero coeffienents due to the loaded wavefunction file has basis linear dependency
subroutine outmkl(outname,ifileid)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) outname
integer ifileid
character symbol,writeformat*20,selectyn
character*4 irrep(nmo)

write(*,*) "Will the generated .mkl file be used for ORCA? (y/n)"
read(*,*) selectyn
write(*,*) "Exporting, please wait..."

open(ifileid,file=outname,status="replace")
write(ifileid,"(a)") "$MKL"
write(ifileid,"(a)") "#"
write(ifileid,"(a)") "# MKL format file produced by Multiwfn"
write(ifileid,"(a)") "#"
write(ifileid,"(a)") "$CHAR_MULT"
write(ifileid,"(2i3)") nint(sum(a(:)%charge)-naelec-nbelec),nint(naelec-nbelec+1)
write(ifileid,"(a)") "$END"
write(ifileid,*)

write(ifileid,"(a)") "$COORD"
do i=1,ncenter
	write(ifileid,"(i4,1x,3f11.6)") a(i)%index,a(i)%x*b2a,a(i)%y*b2a,a(i)%z*b2a
end do
write(ifileid,"(a)") "$END"
write(ifileid,*)

write(ifileid,"(a)") "$BASIS"
do iatm=1,ncenter
	do ish=1,nshell
		if (shcen(ish)==iatm) then
			symbol=shtype2name(shtype(ish))
			write(ifileid,"(i2,1x,a,f4.1)") shtype2nbas(shtype(ish)),symbol,1D0
			if (ish==0) then
				istart=0
			else
				istart=sum(shcon(1:ish-1))
			end if
			do ipsh=istart+1,istart+shcon(ish)
				write(ifileid,"(f19.9,f17.9)") primshexp(ipsh),primshcoeff(ipsh)
			end do
		end if
	end do
	if (iatm/=ncenter) write(ifileid,"(a)") "$$"
end do
write(ifileid,"(a)") "$END"
write(ifileid,*)

nframe=ceiling(nbasis/5D0)
!if (allocated(MOsym)) then
!    irrep=MOsym
!else
    irrep=" a1g" !orca_2mkl convention
!end if
write(ifileid,"(a)") "$COEFF_ALPHA"
do iframe=1,nframe
    if (iframe/=nframe) then
        ncol=5
    else
        ncol=nbasis-(nframe-1)*5
    end if
    ibeg=(iframe-1)*5+1
    iend=(iframe-1)*5+ncol
    write(writeformat,"('(',i1,'(a,1x))')") ncol
    write(ifileid,writeformat) irrep(ibeg:iend)
    write(writeformat,"('(',i1,'(f13.7,1x))')") ncol
    write(ifileid,writeformat) MOene(ibeg:iend)
    write(writeformat,"('(',i1,'(f12.7,1x))')") ncol
	do ibas=1,nbasis
        itmp=bastype(ibas)
        if ((selectyn=='y'.or.selectyn=='Y').and.(itmp==-6.or.itmp==-7.or.(itmp>=-16.and.itmp<=-13).or.(itmp>=-29.and.itmp<=-26))) then
            !write(*,"(2i5,1x,a)") ibas,itmp,GTFtype2name(itmp)
            write(ifileid,writeformat) -CObasa(ibas,ibeg:iend)
        else
            write(ifileid,writeformat) CObasa(ibas,ibeg:iend)
        end if
	end do
end do
write(ifileid,"(a)") " $END"
write(ifileid,*)

write(ifileid,"(a)") "$OCC_ALPHA"
write(ifileid,"(5f12.7)") MOocc(1:nbasis)
write(ifileid,"(a)") " $END"

if (wfntype==1.or.wfntype==4) then !Open shell
    write(ifileid,*)
    write(ifileid,"(a)") "$COEFF_BETA"
    do iframe=1,nframe
        if (iframe/=nframe) then
            ncol=5
        else
            ncol=nbasis-(nframe-1)*5
        end if
        ibeg=(iframe-1)*5+1
        iend=(iframe-1)*5+ncol
        write(writeformat,"('(',i1,'(a,1x))')") ncol
        write(ifileid,writeformat) irrep(ibeg+nbasis:iend+nbasis)
        write(writeformat,"('(',i1,'(f13.7,1x))')") ncol
        write(ifileid,writeformat) MOene(ibeg+nbasis:iend+nbasis)
        write(writeformat,"('(',i1,'(f12.7,1x))')") ncol
	    do ibas=1,nbasis
            itmp=bastype(ibas)
            if ((selectyn=='y'.or.selectyn=='Y').and.(itmp==-6.or.itmp==-7.or.(itmp>=-16.and.itmp<=-13).or.(itmp>=-29.and.itmp<=-26))) then
                write(ifileid,writeformat) -CObasb(ibas,ibeg:iend)
            else
                write(ifileid,writeformat) CObasb(ibas,ibeg:iend)
            end if
	    end do
    end do
    write(ifileid,"(a)") " $END"
    write(ifileid,*)

    write(ifileid,"(a)") "$OCC_BETA"
    write(ifileid,"(5f12.7)") MOocc(nbasis+1:nmo)
    write(ifileid,"(a)") " $END"
end if

close(ifileid)
end subroutine

!!--------------- Interface of outputting .fch file
subroutine outfch_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for outputting .fch file, e.g. C:\sunshine\riko.fch"
write(*,"(a)") " If press ENTER button directly, the system will be exported to "//trim(c200tmp)//".fch in current folder"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".fch"
call outfch(outname,10,1)
end subroutine
!!!--------------- Output current wavefunction to .fch file
!informode=1: print prompt message, =0: do not print
subroutine outfch(outname,ifileid,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) outname
integer ifileid,infomode
open(ifileid,file=outname,status="replace")
write(ifileid,"(a)") "Generated by Multiwfn"
if (wfntype==0.or.wfntype==3) write(ifileid,"(a10,a30,a30)") "SP        ","RB3LYP                        ","                      6-31G(d)"
if (wfntype==1.or.wfntype==4) write(ifileid,"(a10,a30,a30)") "SP        ","UB3LYP                        ","                      6-31G(d)"
if (wfntype==2)               write(ifileid,"(a10,a30,a30)") "SP        ","ROB3LYP                       ","                      6-31G(d)"
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of atoms                         ","I",ncenter
write(ifileid,"(A40,3X,A1,5X,I12)") "Charge                                  ","I",nint(sum(a%charge)-nelec)
write(ifileid,"(A40,3X,A1,5X,I12)") "Multiplicity                            ","I",nint(naelec-nbelec)+1
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of electrons                     ","I",nint(nelec)
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of alpha electrons               ","I",nint(naelec)
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of beta electrons                ","I",nint(nbelec)
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of basis functions               ","I",nbasis
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of independent functions         ","I",nbasis
if (ifPBC>0) write(ifileid,"(A40,3X,A1,5X,I12)") "Number of translation vectors           ","I",ifPBC
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Atomic numbers                          ","I",ncenter
write(ifileid,"(6I12)") a(:)%index
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Nuclear charges                         ","R",ncenter
write(ifileid,"(5(1PE16.8))") a(:)%charge
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Current cartesian coordinates           ","R",ncenter*3
write(ifileid,"(5(1PE16.8))") (a(i)%x,a(i)%y,a(i)%z,i=1,ncenter)
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Translation vectors                     ","R",ifPBC*3
if (ifPBC==1) write(ifileid,"(3(1PE16.8))") cellv1(:)
if (ifPBC==2) write(ifileid,"(5(1PE16.8))") cellv1(:),cellv2(:)
if (ifPBC==3) write(ifileid,"(5(1PE16.8))") cellv1(:),cellv2(:),cellv3(:)
!Basis function definition
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of contracted shells             ","I",nshell
write(ifileid,"(A40,3X,A1,5X,I12)") "Number of primitive shells              ","I",nprimshell
write(ifileid,"(A40,3X,A1,5X,I12)") "Highest angular momentum                ","I",maxval(abs(shtype))
write(ifileid,"(A40,3X,A1,5X,I12)") "Largest degree of contraction           ","I",maxval(abs(shcon))
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Shell types                             ","I",nshell
write(ifileid,"(6I12)") shtype(:)
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Number of primitives per shell          ","I",nshell
write(ifileid,"(6I12)") shcon(:)
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Shell to atom map                       ","I",nshell
write(ifileid,"(6I12)") shcen(:)
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Primitive exponents                     ","R",nprimshell
write(ifileid,"(5(1PE16.8))") primshexp(:)
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Contraction coefficients                ","R",nprimshell
write(ifileid,"(5(1PE16.8))") primshcoeff(:)
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Coordinates of each shell               ","R",nshell*3
write(ifileid,"(5(1PE16.8))") (a(shcen(i))%x,a(shcen(i))%y,a(shcen(i))%z,i=1,nshell)
write(ifileid,"(A40,3X,A1,5X,1PE22.15)") "Virial Ratio                            ","R",virialratio
write(ifileid,"(A40,3X,A1,5X,1PE22.15)") "Total Energy                            ","R",totenergy
!After careful investigation, I found the following information is needed if you want to use unfchk &
!to convert it to chk and read guess from it, without it Gaussian will only read alpha orbitals as guess.
!According to Gaussian programmer's manual, the meaning of the first slot of ILSW is: 0=real HF (default) 1=real etc.
!I found R and RO calculation doesn't need this
if (wfntype==1.or.wfntype==4) then
    write(ifileid,"(a)") "Num ILSW                                   I              1"
    write(ifileid,"(a)") "ILSW                                       I   N=         1"
    write(ifileid,"(a)") "           1"
end if
!Orbital informaiton
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Alpha Orbital Energies                  ","R",nbasis
write(ifileid,"(5(1PE16.8))") MOene(1:nbasis)
if (wfntype==1.or.wfntype==4) then
	write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Beta Orbital Energies                   ","R",nbasis
	write(ifileid,"(5(1PE16.8))") MOene(nbasis+1:2*nbasis)
end if
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Alpha MO coefficients                   ","R",nbasis*nbasis
write(ifileid,"(5(1PE16.8))") ((CObasa(ibasis,imo),ibasis=1,nbasis),imo=1,nbasis)
if (wfntype==1.or.wfntype==4) then
	write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Beta MO coefficients                    ","R",nbasis*nbasis
	write(ifileid,"(5(1PE16.8))") ((CObasb(ibasis,imo),ibasis=1,nbasis),imo=1,nbasis)
end if
write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Total SCF Density                       ","R",nbasis*(nbasis+1)/2
write(ifileid,"(5(1PE16.8))") ((Ptot(i,j),j=1,i),i=1,nbasis)
if (wfntype==1.or.wfntype==4) then
	write(ifileid,"(A40,3X,A1,3X,'N=',I12)") "Spin SCF Density                        ","R",nbasis*(nbasis+1)/2
	write(ifileid,"(5(1PE16.8))") ((Palpha(i,j)-Pbeta(i,j),j=1,i),i=1,nbasis)
end if
close(ifileid)
if (infomode==1) then
	if (wfntype==0.or.wfntype==2.or.wfntype==3) then
		write(*,"(a)") " Exporting .fch file finished! The ""Total SCF Density"" field in this file corresponds to density matrix at current level"
	else
		write(*,"(a)") " Exporting .fch file finished! The ""Total SCF Density"" and ""Spin SCF Density"" fields in this file correspond &
		to total density matrix and difference between alpha and beta density matrices at current level, respectively"
	end if
end if
end subroutine

!!!---------- Output current wavefunction to .47 file, which is input file of NBO program
!Notice that although "UPPER" keyword is used here, in fact the matrix recorded in .47 is lower-triangular matrix (i.e. NBO's rule is confusing!)
subroutine out47(outname,ifileid)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) outname
character(80) c80tmp1,c80tmp2
real*8 primshcoefftmp(nprimshell)
real*8,allocatable :: halfmat(:)
real*8,external :: normgau
integer bastype2NBO(50),nptr(nshell)
integer ifileid
bastype2NBO(1 )=1   !s
bastype2NBO(2 )=101 !x
bastype2NBO(3 )=102 !y
bastype2NBO(4 )=103 !z
bastype2NBO(5 )=201 !xx
bastype2NBO(8 )=202 !xy
bastype2NBO(9 )=203 !xz
bastype2NBO(6 )=204 !yy
bastype2NBO(10)=205 !yz
bastype2NBO(7 )=206 !zz
bastype2NBO(11)=301 !xxx
bastype2NBO(14)=302 !xxy
bastype2NBO(15)=303 !xxz
bastype2NBO(17)=304 !xyy
bastype2NBO(20)=305 !xyz
bastype2NBO(18)=306 !xzz
bastype2NBO(12)=307 !yyy
bastype2NBO(16)=308 !yyz
bastype2NBO(19)=309 !yzz
bastype2NBO(13)=310 !zzz
!Below g sequence comes from line 47384 in NBO_5 src
bastype2NBO(35)=401 !XXXX
bastype2NBO(34)=402 !XXXY
bastype2NBO(33)=403 !XXXZ
bastype2NBO(32)=404 !XXYY
bastype2NBO(31)=405 !XXYZ
bastype2NBO(30)=406 !XXZZ
bastype2NBO(29)=407 !XYYY
bastype2NBO(28)=408 !XYYZ
bastype2NBO(27)=409 !XYZZ
bastype2NBO(26)=410 !XZZZ
bastype2NBO(25)=411 !YYYY
bastype2NBO(24)=412 !YYYZ
bastype2NBO(23)=413 !YYZZ
bastype2NBO(22)=414 !YZZZ
bastype2NBO(21)=415 !ZZZZ

if (any(shtype<0)) then
	write(*,*) "Error: This function only works when all basis functions are Cartesian type!"
	write(*,"(a)") " Hint: If you set ""iloadasCart"" in settings.ini to 1, then all spherical harmonic type of &
	basis functions will be converted to Cartesian type when loading input file, and then this function will be usable"
	write(*,*) "Press ENTER button to return"
	read(*,*)
	return
end if

write(*,*) "Exporting, please wait..."

open(ifileid,file=outname,status="replace")
write(c80tmp1,*) ncenter
write(c80tmp2,*) nbasis
if (wfntype==0.or.wfntype==3) then !Closed-shell
	write(ifileid,"(' $GENNBO NATOMS=',a,' NBAS=',a,' UPPER BODM $END')") trim(adjustl(c80tmp1)),trim(adjustl(c80tmp2))
else !Open-shell
	write(ifileid,"(' $GENNBO NATOMS=',a,' NBAS=',a,' UPPER BODM OPEN $END')") trim(adjustl(c80tmp1)),trim(adjustl(c80tmp2))
end if
write(ifileid,*) "$NBO $END"
write(ifileid,*) "$COORD"
write(ifileid,*) "Generated by Multiwfn"
do iatm=1,ncenter
	write(ifileid,"(2i6,3f12.6)") a(iatm)%index,int(a(iatm)%charge),a(iatm)%x*b2a,a(iatm)%y*b2a,a(iatm)%z*b2a
end do
write(ifileid,*) "$END"

!Basis function information
write(ifileid,*) "$BASIS"
write(ifileid,"(' CENTER =')")
write(ifileid,"(10i6)") bascen(:)
write(ifileid,"(' LABEL =')")
write(ifileid,"(10i6)") bastype2NBO(bastype(:))
write(ifileid,"(' $END')")

!Shell information
write(ifileid,*) "$CONTRACT"
write(ifileid,"(' NSHELL =',i6)") nshell
write(ifileid,"('   NEXP =',i6)") nprimshell
write(ifileid,"('  NCOMP =')")
write(ifileid,"(10i6)") shtype2nbas(shtype(:))
write(ifileid,"('  NPRIM =')")
write(ifileid,"(10i6)") shcon(:)
nptr(1)=1
do ish=2,nshell
	nptr(ish)=nptr(ish-1)+shcon(ish-1)
end do
write(ifileid,"('   NPTR =')")
write(ifileid,"(10i6)") nptr(:)
write(ifileid,"('    EXP =')")
write(ifileid,"(4E16.7)") primshexp(:)
!In standard .47 and .37 file, the shell contraction coefficients include normalization coefficients
!For d, f, g, the normalization coefficients are for XX/YY/ZZ, XXX/YYY/ZZZ, XXXX/YYYY/ZZZZ, respectively
do iang=0,maxval(abs(shtype))
	primshcoefftmp=0
	if (iang==0) then
		write(ifileid,"('     CS =')")
		do ish=1,nshell
			if (shtype(ish)==0) then
				do icon=1,shcon(ish)
					iprimshnow=nptr(ish)+icon-1
					primshcoefftmp(iprimshnow)=primshcoeff(iprimshnow)*normgau(1,primshexp(iprimshnow))
				end do
			end if
		end do
	else if (iang==1) then
		write(ifileid,"('     CP =')")
		do ish=1,nshell
			if (shtype(ish)==1) then
				do icon=1,shcon(ish)
					iprimshnow=nptr(ish)+icon-1
					primshcoefftmp(iprimshnow)=primshcoeff(iprimshnow)*normgau(2,primshexp(iprimshnow))
				end do
			end if
		end do
	else if (iang==2) then
		write(ifileid,"('     CD =')")
		do ish=1,nshell
			if (shtype(ish)==2) then
				do icon=1,shcon(ish)
					iprimshnow=nptr(ish)+icon-1
					primshcoefftmp(iprimshnow)=primshcoeff(iprimshnow)*normgau(5,primshexp(iprimshnow))
				end do
			end if
		end do
	else if (iang==3) then
		write(ifileid,"('     CF =')")
		do ish=1,nshell
			if (shtype(ish)==3) then
				do icon=1,shcon(ish)
					iprimshnow=nptr(ish)+icon-1
					primshcoefftmp(iprimshnow)=primshcoeff(iprimshnow)*normgau(11,primshexp(iprimshnow))
				end do
			end if
		end do
	else if (iang==4) then
		write(ifileid,"('     CG =')")
		do ish=1,nshell
			if (shtype(ish)==4) then
				do icon=1,shcon(ish)
					iprimshnow=nptr(ish)+icon-1
					primshcoefftmp(iprimshnow)=primshcoeff(iprimshnow)*normgau(21,primshexp(iprimshnow))
				end do
			end if
		end do
	end if
	write(ifileid,"(4E16.7)") primshcoefftmp(:)
end do
write(ifileid,"(' $END')")

allocate(halfmat(nbasis*(nbasis+1)/2))

!Overlap matrix
write(ifileid,"(' $OVERLAP')")
call mat2arr(Sbas,halfmat,2)
write(ifileid,"(5E15.7)") halfmat(:)
write(ifileid,"(' $END')")

!Density matrix
write(ifileid,"(' $DENSITY')")
if (wfntype==0.or.wfntype==3) then !Closed-shell
	call mat2arr(Ptot,halfmat,2)
	write(ifileid,"(5E15.7)") halfmat(:)
else !Open-shell
	call mat2arr(Palpha,halfmat,2)
	write(ifileid,"(5E15.7)") halfmat(:)
	call mat2arr(Pbeta,halfmat,2)
	write(ifileid,"(5E15.7)") halfmat(:)
end if
write(ifileid,"(' $END')")

!Fock matrix
if (allocated(FmatA).or.wfntype<=2) then
    write(*,*)
    write(*,*) "If writing Fock matrix to .47 file?"
    write(*,*) "0 Do not write"
    if (wfntype<=2) write(*,"(a)") " 1 Generate Fock matrix based on MO energies and coefficients via F=SCE(C^-1) and write it to .47 file"
    if (allocated(FmatA)) write(*,"(a)") " 2 Write the Fock matrix in memory to .47 file"
    read(*,*) iwriteF
    if (iwriteF==1) then
        call MOene2Fmat(istatus)
        if (istatus==1) write(*,"(a)") " Warning: Since Fock matrix was not successfully generated and thus will not be written to .47 file"
    end if
    if ((iwriteF==1.and.istatus==0).or.iwriteF==2) then
        write(ifileid,"(' $FOCK')")
	    call mat2arr(FmatA,halfmat,2)
	    write(ifileid,"(5E15.7)") halfmat(:)
        if (wfntype==1) then
	        call mat2arr(FmatB,halfmat,2)
	        write(ifileid,"(5E15.7)") halfmat(:)
        end if
        write(ifileid,"(' $END')")
    end if
end if

!LCAOMO matrix. Note that if "iloadasCart" is set to 1, when loading .molden and .fch where spherical harmonic basis functions are presented, &
!they will be converted to Cartesian type and retain this status. In this case some highest MOs have zero coefficients, but NBO can still work normally
! if (nmo==nbasis.or.nmo==2*nbasis) then !The input file must only contain Cartesian basis functions
write(ifileid,"(' $LCAOMO')")
if (wfntype==0.or.wfntype==2.or.wfntype==3) then !R or RO
	do imo=1,nmo
		write(ifileid,"(5E15.7)") CObasa(:,imo)
	end do
	if (wfntype==2) then !RO, output orbitals twice
		do imo=1,nmo
			write(ifileid,"(5E15.7)") CObasa(:,imo)
		end do
	end if
else !U
	do imo=1,nbasis
		write(ifileid,"(5E15.7)") CObasa(:,imo)
	end do
	do imo=1,nbasis
		write(ifileid,"(5E15.7)") CObasb(:,imo)
	end do
end if
write(ifileid,"(' $END')")

!Dipole matrix
if (.not.allocated(Dbas)) then
    write(*,*) "Generating electric dipole moment integral matrix..."
    call genDbas_curr
end if

write(ifileid,"(' $DIPOLE')")
call mat2arr(Dbas(1,:,:),halfmat,2)
write(ifileid,"(5E15.7)") halfmat(:)*(-b2a) !Must be converted from Bohr to Angstrom
call mat2arr(Dbas(2,:,:),halfmat,2)
write(ifileid,"(5E15.7)") halfmat(:)*(-b2a)
call mat2arr(Dbas(3,:,:),halfmat,2)
write(ifileid,"(5E15.7)") halfmat(:)*(-b2a)
write(ifileid,"(' $END')")

close(ifileid)
write(*,*)
write(*,*) "Exporting .47 file finished!"
end subroutine

!!!------------ Interface of outputting .mwfn file
subroutine outmwfn_wrapper
use defvar
use util
character*200 outname,c200tmp
integer iexp
if (.not.allocated(CObasa)) then
	write(*,"(a)") " Error: This function works only when input file contains basis function information"
    write(*,*) "Press ENTER button to continue"
    read(*,*)
else
    call path2filename(filename,c200tmp)
	write(*,*) "Input path for exporting file, e.g. C:\ltwd.mwfn"
    write(*,"(a)") " If press ENTER button directly, will be exported to "//trim(c200tmp)//".mwfn"
	read(*,"(a)") outname
    if (outname==" ") outname=trim(c200tmp)//".mwfn"
    write(*,*) "0 Only export wavefunction"
    write(*,*) "1 Export both wavefunction and density matrix"
    write(*,*) "2 Export wavefunction, density matrix and overlap matrix"
    read(*,*) iexp
	write(*,*) "Exporting, please wait..."
	call outmwfn(outname,10,iexp)
	write(*,*) "Exporting .mwfn file finished!"
end if
end subroutine
!!!------------ Output current wavefunction to .mwfn file
!ifileid is the file id that can be used during outputting
!iprint=0: Do not print any matrix, =1: Print density matrix, =2: Print density matrix and overlap matrix
!informode=1: Output prompt message, =0: Do not Output
subroutine outmwfn(outname,ifileid,iprint)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) outname
integer ifileid,infomode
open(ifileid,file=outname,status="replace")
write(ifileid,"(a)") "# Generated by Multiwfn" !Comment
write(ifileid,"('Wfntype=',i4)") wfntype
write(ifileid,"('Charge=',f15.6)") sum(a%charge)-nelec
write(ifileid,"('Naelec=',f15.6)") naelec
write(ifileid,"('Nbelec=',f15.6)") nbelec
write(ifileid,"('E_tot=',1PE16.8)") totenergy
write(ifileid,"('VT_ratio=',f12.8)") virialratio
if (ifPBC>0) then
    write(ifileid,"('Ndim=',i4)") ifPBC
    write(ifileid,"('cellv1=',3f12.8)") cellv1(:)*b2a
    if (ifPBC>1) write(ifileid,"('cellv2=',3f12.8)") cellv2(:)*b2a
    if (ifPBC>2) write(ifileid,"('cellv3=',3f12.8)") cellv3(:)*b2a
end if
write(ifileid,"(/,a)") "# Atom information"
write(ifileid,"('Ncenter=',i8)") ncenter
write(ifileid,"('$Centers')")
do icen=1,ncenter
    write(ifileid,"(i6,1x,a,i4,f6.1,3f16.8)") icen,a(icen)%name,a(icen)%index,a(icen)%charge,a(icen)%x*b2a,a(icen)%y*b2a,a(icen)%z*b2a
end do

!Determine nindbasis. I found this is highly unreliable, so not use
!nindbasis=0
!do imo=1,nbasis
!    !if (any(CObasa(:,imo)/=0)) then
!    if (any(CO(imo,:)/=0)) then
!        nindbasis=nindbasis+1
!    else
!        write(*,*) imo
!    end if
!end do

write(ifileid,"(/,a)") "# Basis function information"
write(ifileid,"('Nbasis=    ',i8)") nbasis
if (nindbasis==0) then !nindbasis was not loaded, simply set the same as nbasis
    write(ifileid,"('Nindbasis= ',i8)") nbasis
else
    write(ifileid,"('Nindbasis= ',i8)") nindbasis
end if
write(ifileid,"('Nprims=    ',i8)") nprims
write(ifileid,"('Nshell=    ',i8)") nshell
write(ifileid,"('Nprimshell=',i8)") nprimshell
write(ifileid,"('$Shell types')")
write(ifileid,"(25i3)") shtype(:)
write(ifileid,"('$Shell centers')")
write(ifileid,"(10i8)") shcen(:)
write(ifileid,"('$Shell contraction degrees')")
write(ifileid,"(20i4)") shcon(:)
write(ifileid,"('$Primitive exponents')")
write(ifileid,"(5(1PE16.8))") primshexp(:)
write(ifileid,"('$Contraction coefficients')")
write(ifileid,"(5(1PE16.8))") primshcoeff(:)

!Output orbital information
if (wfntype==0.or.wfntype==3) then
    write(ifileid,"(/,a)") "# Orbital information (nindbasis orbitals)"
else
    write(ifileid,"(/,a)") "# Orbital information (2*nindbasis orbitals)"
end if
irealorb=0
nzero=0
do imo=1,nmo
    !Orbitals having all-zero coefficents, which is caused by linear-dependency, are not exported
    if (MOtype(imo)<=1) then !Spatial or alpha orbital
        if (all(CObasa(:,imo)==0).and.nindbasis<nbasis) then
            nzero=nzero+1
            cycle
        end if
    else
        if (all(CObasb(:,imo-nbasis)==0).and.nindbasis<nbasis) then
            nzero=nzero+1
            cycle
        end if
    end if

    irealorb=irealorb+1
    write(ifileid,*)
    write(ifileid,"('Index=',i10)") irealorb
	write(ifileid,"('Type=',i2)") MOtype(imo)
	write(ifileid,"('Energy=',1PE16.8)") MOene(imo)
	write(ifileid,"('Occ=',f12.8)") MOocc(imo)
	if (allocated(MOsym)) then
        if (MOsym(imo)/=" ") then
            write(ifileid,"('Sym=',1x,a)") MOsym(imo)
        else
            write(ifileid,"('Sym= ?')")
        end if
    else
        write(ifileid,"('Sym= ?')")
    end if
    write(ifileid,"('$Coeff')")
    if (MOtype(imo)<=1) then !Spatial or alpha orbital
		write(ifileid,"(5(1PE16.8))") CObasa(:,imo)
    else
		write(ifileid,"(5(1PE16.8))") CObasb(:,imo-nbasis)
    end if
end do
if (nzero>0) write(*,"(a,i5,a)") " Note: There are",nzero," orbitals with all-zero coefficients, which were not exported"

if (iprint>=1) then
    write(ifileid,"(/,a)") "# Various matrices"
    if (wfntype==0.or.wfntype==3) then
        write(ifileid,"(/,'$Total density matrix, dim=',2i5,'  lower= 1')") nbasis,nbasis !nbasis*(nbasis+1)/2 elements
        write(ifileid,"(5(1PE16.8))") ((Ptot(i,j),j=1,i),i=1,nbasis)
    else
        write(ifileid,"(/,'$Alpha density matrix, dim=',2i5,'  lower= 1')") nbasis,nbasis !nbasis*(nbasis+1)/2 elements
        write(ifileid,"(5(1PE16.8))") ((Palpha(i,j),j=1,i),i=1,nbasis)
        write(ifileid,"(/,'$Beta density matrix, dim=',2i5,'  lower= 1')") nbasis,nbasis !nbasis*(nbasis+1)/2 elements
        write(ifileid,"(5(1PE16.8))") ((Pbeta(i,j),j=1,i),i=1,nbasis)
    end if
    if (iprint==2) then
        write(ifileid,"(/,'$Overlap matrix, dim=',2i5,'  lower= 1')") nbasis,nbasis !nbasis*(nbasis+1)/2 elements
        write(ifileid,"(5(1PE16.8))") ((Sbas(i,j),j=1,i),i=1,nbasis)
    end if
end if
close(ifileid)
end subroutine

!!!------------ Read wavefunction from .mwfn file
!infomode=0 means output info, =1 silent
subroutine readmwfn(name,infomode)
use defvar
use util
implicit real*8 (a-h,o-z)
character(len=*) name
!Temporary arrays used in process data
integer,allocatable :: shelltype(:),shell2atom(:),shellcon(:)
real*8,allocatable :: primexp(:),concoeff(:),amocoeff(:,:),bmocoeff(:,:)
integer :: s2f(-5:5,21)=0
real*8 conv5d6d(6,5),conv7f10f(10,7),conv9g15g(15,9),conv11h21h(21,11)
character selectyn,c80tmp*80,c80tmp2*80
!For backing up spherical basis functions
integer,allocatable :: shelltype5D(:),MOtype5D(:)
real*8,allocatable :: CObasa5D(:,:),CObasb5D(:,:),MOocc5D(:),MOene5D(:),CO5D(:,:)
real*8,external :: normgau

ifiletype=14
imodwfn=0
s2f(-5,1:11)=(/ -32,-31,-30,-29,-28,-27,-26,-25,-24,-23,-22 /)
s2f(-4,1:9)=(/ -21,-20,-19,-18,-17,-16,-15,-14,-13 /)
s2f(-3,1:7)=(/ -12,-11,-10,-9,-8,-7,-6 /)
s2f(-2,1:5)=(/ -5,-4,-3,-2,-1 /)
s2f(-1,1:4)=(/ 1,2,3,4 /)
s2f(0,1)=1
s2f(1,1:3)=(/ 2,3,4 /)
s2f(2,1:6)=(/ 5,6,7,8,9,10 /)
s2f(3,1:10)=(/ 11,12,13,17,14,15,18,19,16,20 /) !Note: The sequence of f functions in Multiwfn is not identical to .fch, so convert here. While spdgh are identical
s2f(4,1:15)=(/ 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35 /)
s2f(5,1:21)=(/ 36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56 /)
call gensphcartab(1,conv5d6d,conv7f10f,conv9g15g,conv11h21h)

open(10,file=name,status="old")
if (infomode==0) write(*,*) "Loading various information of the wavefunction"

Nframe=1
call loclabel(10,'@Nframe',ifound,maxline=10)
if (ifound==1) then
    read(10,*) c80tmp,Nframe
    rewind(10)
    write(*,"(/,' There are',i8,' frames, load which one? e.g. 5')") Nframe
    read(*,*) iframe
end if

call loclabel(10,'Wfntype=')
read(10,*) c80tmp,wfntype
!call loclabel(10,'Charge=') !This information is not explicitly used by Multiwfn
!read(10,*) c80tmp,Charge
call loclabel(10,'Naelec=')
read(10,*) c80tmp,naelec
call loclabel(10,'Nbelec=')
read(10,*) c80tmp,nbelec
call loclabel(10,'E_tot=',ifound,maxline=100)
totenergy=0
if (ifound==1) read(10,*) c80tmp,totenergy
call loclabel(10,'VT_ratio=',ifound,maxline=100)
virialratio=0
if (ifound==1) read(10,*) c80tmp,virialratio
call loclabel(10,'Ndim',ifound,maxline=100)
ifPBC=0
if (ifound==1) read(10,*) c80tmp,ifPBC
if (ifPBC>0) then
    call loclabel(10,'cellv1',ifound,0)
    read(10,*) c80tmp,cellv1
end if
if (ifPBC>1) then
    call loclabel(10,'cellv2',ifound,0)
    read(10,*) c80tmp,cellv2
end if
if (ifPBC>2) then
    call loclabel(10,'cellv3',ifound,0)
    read(10,*) c80tmp,cellv3
end if

!Load atom information
call loclabel(10,'Ncenter=')
read(10,*) c80tmp,ncenter
allocate(a(ncenter))
call loclabel(10,'$Centers');read(10,*)
do icen=1,ncenter
    read(10,*) inouse,a(icen)%name,a(icen)%index,a(icen)%charge,a(icen)%x,a(icen)%y,a(icen)%z
end do

!Load basis function information
if (infomode==0) write(*,*) "Loading basis and primitive shell information..."
call loclabel(10,'Nbasis=')
read(10,*) c80tmp,nbasis
call loclabel(10,'Nindbasis=')
read(10,*) c80tmp,nindbasis
call loclabel(10,'Nprims=')
read(10,*) c80tmp,nprims
call loclabel(10,'Nshell=')
read(10,*) c80tmp,nshell
call loclabel(10,'Nprimshell=')
read(10,*) c80tmp,nprimshell
allocate(shelltype(nshell),shell2atom(nshell),shellcon(nshell))
call loclabel(10,'$Shell types');read(10,*)
read(10,*) shelltype
call loclabel(10,'$Shell centers');read(10,*)
read(10,*) shell2atom
call loclabel(10,'$Shell contraction degrees');read(10,*)
read(10,*) shellcon
allocate(primexp(nprimshell),concoeff(nprimshell))
call loclabel(10,'$Primitive exponents');read(10,*)
read(10,*) primexp
call loclabel(10,'$Contraction coefficients');read(10,*)
read(10,*) concoeff

!Copy information from local arrays to global arrays
allocate(shtype(nshell),shcen(nshell),shcon(nshell),primshexp(nprimshell),primshcoeff(nprimshell))
shtype=shelltype
shcen=shell2atom
shcon=shellcon
primshexp=primexp
primshcoeff=concoeff

!Multiwfn allows Cartesian and spherical basis functions mixed together. If any basis function is spherical, then isphergau=1
!Only the spherical ones will be treated specially
if (infomode==0) write(*,"(' The highest angular moment basis functions is ',a)") shtype2name(maxval(abs(shelltype)))
isphergau=0
if (any(shelltype<=-2)) isphergau=1
if (any(abs(shelltype)>5).and.infomode==0) then
	write(*,"(a)") " Error: GTFs with angular moment higher than h are found, while Multiwfn currently only supports up to h. Press Enter button to exit"
	read(*,*)
	stop
end if

if (nframe>1) then !Locate to specific frame
    write(c80tmp,*) iframe
    call loclabel(10,"@Frame= "//trim(adjustl(c80tmp)),ifound)
    if (ifound==0) then
        write(*,"(' Error: Unable to locate to frame',i8,' in the mwfn file!')") iframe
        write(*,*) "Press ENTER button to exit"
        read(*,*)
        stop
    else
        do while(.true.)
            read(10,"(a)") c80tmp
            if (index(c80tmp,'Naelec=')/=0) then
                read(c80tmp,*) c80tmp2,naelec
            else if (index(c80tmp,'Nbelec=')/=0) then
                read(c80tmp,*) c80tmp2,nbelec
            else if (index(c80tmp,'E_tot=')/=0) then
                read(c80tmp,*) c80tmp2,totenergy
            else if (index(c80tmp,'VT_ratio=')/=0) then
                read(c80tmp,*) c80tmp2,virialratio
            else if (index(c80tmp,'cellv1=')/=0) then
                read(c80tmp,*) c80tmp2,cellv1
            else if (index(c80tmp,'cellv2=')/=0) then
                read(c80tmp,*) c80tmp2,cellv2
            else if (index(c80tmp,'cellv3=')/=0) then
                read(c80tmp,*) c80tmp2,cellv3
            else if (index(c80tmp,'Nindbasis=')/=0) then
                read(c80tmp,*) c80tmp2,nindbasis
            else if (index(c80tmp,'$Centers')/=0) then
                do icen=1,ncenter
                    read(10,*) inouse,a(icen)%name,a(icen)%index,a(icen)%charge,a(icen)%x,a(icen)%y,a(icen)%z
                end do
            else if (index(c80tmp,'Index=         1')/=0) then
                backspace(10)
                exit
            end if
        end do
    end if
end if

!Some treatments
nelec=naelec+nbelec
a%x=a%x/b2a
a%y=a%y/b2a
a%z=a%z/b2a
cellv1=cellv1/b2a
cellv2=cellv2/b2a
cellv3=cellv3/b2a
if (any(a%index==0).and.infomode==0) then
	write(*,*)
	write(*,*) "One or more dummy atoms (X) are found. Do you want to load them? (y/n)"
	write(*,"(a)") " Note: If all of them have corresponding basis functions, then they can be safely loaded. &
	However, if some of them do not have basis functions, in general they should not be loaded, otherwise &
    problems or crashes may occur when performing analyses based on wavefunction"
	read(*,*) selectyn
	if (selectyn=='n'.or.selectyn=='N') then
        do itime=1,ncenter
            backspace(10)
        end do
        ncenter=count(a%index/=0)
        deallocate(a);allocate(a(ncenter))
        icen=0
        do while(icen<=ncenter)
            read(10,*) inouse,c80tmp,itest
            if (itest/=0) then
                icen=icen+1
                backspace(10)
                read(10,*) inouse,a(icen)%name,a(icen)%index,a(icen)%charge,a(icen)%x,a(icen)%y,a(icen)%z
            end if
        end do
    end if
end if

!Load orbital information
!Note: Some basis maybe removed by linear dependence checking, hence the number of orbitals (nindbasis or 2*nindbasis) may be less than nbasis
!The information of those undefined orbitals (i.e. whose index is between nindbasis+1 and nbasis) are all set to zero
if (infomode==0) write(*,*) "Loading orbitals..."
if (wfntype==0.or.wfntype==2.or.wfntype==3) then !Restricted closed-shell or restricted open-shell
	nmo=nbasis
	allocate(amocoeff(nmo,nbasis))
    amocoeff=0
    norbload=nindbasis
    ires=1
else !Unrestricted open-shell wavefunction
    nmo=2*nbasis
	allocate(amocoeff(nbasis,nbasis),bmocoeff(nbasis,nbasis))
    amocoeff=0;bmocoeff=0
    norbload=2*nindbasis
    ires=0
end if
allocate(MOene(nmo),MOocc(nmo),MOtype(nmo),MOsym(nmo))
MOtype=0
MOocc=0
MOene=0
MOsym="?"
call loclabel(10,'Index=         1',irewind=0)
iaorb=0;iborb=0
do iorb=1,norbload
    if (iorb>1) read(10,*,iostat=ierror) !Skip space line between each orbital
    read(10,*,iostat=ierror) !Skip index line
    if (ierror==0) then
        read(10,*) c80tmp,itype
        if (ires==1) then !Restricted
            MOtype(iorb)=itype
            read(10,*) c80tmp,MOene(iorb)
            read(10,*) c80tmp,MOocc(iorb)
            read(10,*) c80tmp,MOsym(iorb)
            read(10,*)
            read(10,*) amocoeff(:,iorb)
        else !Unrestricted
            if (itype==1) then
                iaorb=iaorb+1
                MOtype(iaorb)=itype
                read(10,*) c80tmp,MOene(iaorb)
                read(10,*) c80tmp,MOocc(iaorb)
                read(10,*) c80tmp,MOsym(iaorb)
                read(10,*)
                read(10,*) amocoeff(:,iaorb)
            else if (itype==2) then
                iborb=iborb+1
                MOtype(nbasis+iborb)=itype
                read(10,*) c80tmp,MOene(nbasis+iborb)
                read(10,*) c80tmp,MOocc(nbasis+iborb)
                read(10,*) c80tmp,MOsym(nbasis+iborb)
                read(10,*)
                read(10,*) bmocoeff(:,iborb)
            end if
        end if
    else !norbload is larger than actual number of recorded orbitals, often because linearly dependent basis functions are eliminated
        write(*,"(i6,' orbitals were actually loaded')") iorb-1
        exit
    end if
end do

close(10)

!!!!!! Loading have finished, now generate basis function information

!Backup spherical basis information (some of them may be Cartesian ones) with 5D suffix (of course, may be actually 7f, 9g, 11h...),
!convert them to Cartesian type temporarily to assign GTF information and calculate various integral matrices, at final stage recovery them back
if (isphergau==1) then
	allocate(shelltype5D(nshell))
	shelltype5D=shelltype
	where (shelltype<=-2) shelltype=-shelltype !Convert to Cartesian type
	nbasis5D=nbasis
	nbasis=0
	do i=1,nshell
		nbasis=nbasis+shtype2nbas(shelltype(i))
	end do
end if
allocate(shtypeCar(nbasis)) !Store shell information of Cartesian basis into global array, which may be used later
shtypeCar=shelltype
nbasisCar=nbasis

!Allocate space for arrays
allocate(b(nprims),CO(nmo,nprims),basshell(nbasis),bascen(nbasis),bastype(nbasis),primstart(nbasis),&
primend(nbasis),primconnorm(nprims),basstart(ncenter),basend(ncenter))
!Fill CObasa and CObasb
if (isphergau==0) then
	allocate(CObasa(nbasis,nbasis))
	CObasa=amocoeff
	if (ires==0) then
		allocate(CObasb(nbasis,nbasis))
		CObasb=bmocoeff
	end if
else if (isphergau==1) then
	allocate(CObasa(nbasis,nbasis),CObasa5D(nbasis5D,nbasis5D))
	CObasa5D=amocoeff
	CObasa=0D0
	if (ires==0) then
		allocate(CObasb(nbasis,nbasis),CObasb5D(nbasis5D,nbasis5D))
		CObasb5D=bmocoeff
		CObasb=0D0
	end if
	!Map 5D coefficient to 6D coefficient
	ipos5D=1
	ipos6D=1
	do ish=1,nshell
		ishtyp5D=shelltype5D(ish)
		ishtyp6D=shelltype(ish)
		numshorb5D=shtype2nbas(ishtyp5D)
		numshorb6D=shtype2nbas(ishtyp6D)
		if (ishtyp5D>=-1) then !S or P or other Cartesian shells
			CObasa(ipos6D:ipos6D+numshorb6D-1,1:nbasis5D)=CObasa5D(ipos5D:ipos5D+numshorb5D-1,:)
			if (ires==0) CObasb(ipos6D:ipos6D+numshorb6D-1,1:nbasis5D)=CObasb5D(ipos5D:ipos5D+numshorb5D-1,:)
		else if (ishtyp5D==-2) then
			!5D->6D
			CObasa(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,CObasa5D(ipos5D:ipos5D+4,:))
			if (ires==0) CObasb(ipos6D:ipos6D+5,1:nbasis5D)=matmul(conv5d6d,CObasb5D(ipos5D:ipos5D+4,:))
		else if (ishtyp5D==-3) then
			!7F->10F
			CObasa(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,CObasa5D(ipos5D:ipos5D+6,:))
			if (ires==0) CObasb(ipos6D:ipos6D+9,1:nbasis5D)=matmul(conv7f10f,CObasb5D(ipos5D:ipos5D+6,:))
		else if (ishtyp5D==-4) then
			!9G->15G
			CObasa(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,CObasa5D(ipos5D:ipos5D+8,:))
			if (ires==0) CObasb(ipos6D:ipos6D+14,1:nbasis5D)=matmul(conv9g15g,CObasb5D(ipos5D:ipos5D+8,:))
		else if (ishtyp5D==-5) then
			!11H->21H
			CObasa(ipos6D:ipos6D+20,1:nbasis5D)=matmul(conv11h21h,CObasa5D(ipos5D:ipos5D+10,:))
			if (ires==0) CObasb(ipos6D:ipos6D+20,1:nbasis5D)=matmul(conv11h21h,CObasb5D(ipos5D:ipos5D+10,:))
		end if
		ipos5D=ipos5D+numshorb5D
		ipos6D=ipos6D+numshorb6D
	end do
end if

if (infomode==0) write(*,*) "Converting basis function information to GTF information..."
!Distribute exponent, functype to every GTF and generate CO(:,:) from amocoeff/bmocoeff
!Fill: b,basshell,bascen,bastype,co,primstart,primend,primconnorm
k=1 !Current position of GTF
iexp=1
ibasis=1 !Current position of basis function
!Note: Below commented with !!! means the line associated to setting basis information
do i=1,nshell !Cycle each shell
	b(k:k+shellcon(i)*shtype2nbas(shelltype(i))-1)%center=shell2atom(i)
	basshell(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=i !!!Set basis attributed to which shell
	bascen(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=shell2atom(i) !!!Set basis attributed to which center
	do j=1,shtype2nbas(shelltype(i)) !Cycle each basis(orbital) in each shell
		b(k:k+shellcon(i)-1)%type=s2f(shelltype(i),j)
		bastype(ibasis)=s2f(shelltype(i),j) !!!Set basis type
		primstart(ibasis)=k !!!From where the GTFs attributed to ibasis'th basis
		primend(ibasis)=k+shellcon(i)-1 !!!To where the GTFs attributed to ibasis'th basis
		do l=1,shellcon(i) !Cycle each GTF in each basis in each shell
			b(k)%exp=primexp(iexp+l-1)
			tnormgau=normgau(b(k)%type,b(k)%exp)  !!!Normalization coefficient of GTFs
			temp=concoeff(iexp+l-1)  !!!Contraction coefficient of GTFs
			primconnorm(k)=temp*tnormgau !Combines contraction and normalization coefficient
			do imo=1,nmo
				if (ires==1) then !R or RO
					CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
				else !U
					if (isphergau==1) then
						if (imo<=nbasis5D) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
						if (imo>nbasis5D) CO(imo,k)=CObasb(ibasis,imo-nbasis5D)*temp*tnormgau
					else
						if (imo<=nbasis) CO(imo,k)=CObasa(ibasis,imo)*temp*tnormgau
						if (imo>nbasis) CO(imo,k)=CObasb(ibasis,imo-nbasis)*temp*tnormgau
					end if
				end if
			end do
			k=k+1
		end do
		ibasis=ibasis+1
	end do
	iexp=iexp+shellcon(i)
end do

!Convert information from Cartesian basis to spherical basis
if (isphergau==1) then
	if (iloadasCart==1) then !For special purpose, keep Cartesian basis functions, e.g. converting spherical .fch/.molden to .47 file
		!Currently nbasis and dimension of all matrix (except for CO) correspond to full Cartesian case, but nmo &
		!and related arrays as well as CO still correspond to spherical harmonic case and thus need to be "expanded", the MO energies are artifically set to 100
		allocate(MOocc5D(nmo),MOene5D(nmo),MOtype5D(nmo),CO5D(nmo,nprims))
		MOocc5D=MOocc
		MOene5D=MOene
		MOtype5D=MOtype
		CO5D=CO
		deallocate(MOocc,MOene,MOtype,CO)
		if (ires==1) then
            nmo=nbasis !R, RO
		else
            nmo=2*nbasis !U
        end if
		allocate(MOocc(nmo),MOene(nmo),MOtype(nmo),CO(nmo,nprims))
		MOocc=0
		MOene=100
		CO=0
		if (ires==1) then !R, RO
			MOtype=0
			MOocc(1:nbasis5D)=MOocc5D
			MOene(1:nbasis5D)=MOene5D
			MOtype(1:nbasis5D)=MOtype5D
			CO(1:nbasis5D,:)=CO5D
		else !U
			MOtype(:nbasis)=1
			MOtype(nbasis+1:)=2
			MOocc(:nbasis5D)=MOocc5D(:nbasis5D)
			MOocc(nbasis+1:nbasis+nbasis5D)=MOocc5D(nbasis5D+1:)
			MOene(:nbasis5D)=MOene5D(:nbasis5D)
			MOene(nbasis+1:nbasis+nbasis5D)=MOene5D(nbasis5D+1:)
			MOtype(:nbasis5D)=MOtype5D(:nbasis5D)
			MOtype(nbasis+1:nbasis+nbasis5D)=MOtype5D(nbasis5D+1:)
			CO(:nbasis5D,:)=CO5D(:nbasis5D,:)
			CO(nbasis+1:nbasis+nbasis5D,:)=CO5D(nbasis5D+1:,:)
		end if
		isphergau=0

	else !Common case, transform to spherical basis
		if (infomode==0) write(*,*) "Back converting basis function information from Cartesian to spherical type..."
		!Recover spherical Gaussian basis function information
		nbasis=nbasis5D
		shelltype=shelltype5D
		ibasis=1
		do i=1,nshell
			basshell(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=i
			bascen(ibasis:ibasis+shtype2nbas(shelltype(i))-1)=shell2atom(i)
			do j=1,shtype2nbas(shelltype(i))
				bastype(ibasis)=s2f(shelltype(i),j)
				ibasis=ibasis+1
			end do
		end do
		deallocate(CObasa)
		allocate(CObasa(nbasis,nbasis))
		CObasa=CObasa5D
		if (ires==0) then
			deallocate(CObasb)
			allocate(CObasb(nbasis,nbasis))
			CObasb=CObasb5D
		end if
	end if
end if

!Generate basstart and basend
nowcen=0
indcen=0
basstart=0 !X atom without basis function will have 0 for basstart and basend
basend=0
do ibasis=1,nbasis
	if (bascen(ibasis)/=nowcen) then
		nowcen=bascen(ibasis)
		indcen=indcen+1
		basstart(indcen)=ibasis
		if (indcen/=1) basend(indcen-1)=ibasis-1
	end if
end do
basend(ncenter)=nbasis

!Generate one-particle density matrix for basis functions
if (igenP==1) then
	if (infomode==0) write(*,*) "Generating density matrix based on orbitals and occupation ..."
	call genP
end if
if (infomode==0) write(*,*) "Generating overlap matrix..."
call genSbas_curr

!Output summary of present wavefunction
if (infomode==0) then
	write(*,*)
	write(*,"(' Total/Alpha/Beta electrons:',3f12.4)") nelec,naelec,nbelec
	write(*,"(' Net charge:',f12.5,'      Expected multiplicity:',i5)") sum(a(:)%charge)-nelec,nint(naelec-nbelec)+1
	write(*,"(' Atoms:',i7,',  Basis functions:',i7,',  GTFs:',i7)") ncenter,nbasis,nprims
	write(*,"(' Total energy:',f21.12,' Hartree,   Virial ratio:',f12.8)") totenergy,virialratio
	if (wfntype==0) then
		write(*,"(' This is a restricted single-determinant wavefunction')")
		write(*,"(' Orbitals from 1 to',i6,' are occupied')") nint(nelec/2)
	else if (wfntype==1) then
		write(*,"(' This is an unrestricted single-determinant wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are occupied')") 1,nbasis,1,nint(naelec)
		write(*,"(' Orbitals from ',i6,' to',i6,' are beta,  from',i6,' to',i6,' are occupied')") nbasis+1,nmo,nbasis+1,nbasis+nint(nbelec)
	else if (wfntype==2) then
		write(*,"(' This is a restricted open-shell wavefunction')")
		write(*,"(' Orbitals from',i6,' to',i6,' are doubly occupied')") 1,nint(nbelec)
		write(*,"(' Orbitals from',i6,' to',i6,' are singly occupied')") nint(nbelec)+1,nint(naelec)
	else if (wfntype==3) then
		write(*,"(' This is a restricted multiconfiguration wavefunction')")
	else if (wfntype==4) then
		write(*,"(' This is an unrestricted multiconfiguration wavefunction')")
		write(*,"(' Orbitals from ',i6,' to',i6,' are alpha, from',i6,' to',i6,' are beta')") 1,nbasis,nbasis+1,nmo
	end if
end if

call getHOMOidx !Find out index of HOMO, will be used in some cases
end subroutine

!!------------------- Read .cif file -------------------
! infomode=0: Output summary, =1: do not
!Sometimes symmetry operations are not explicitly given, but it can be inferred from _symmetry_space_group_name_H-M, &
!However Multiwfn ignores this currently. In principle symmetry operations can always be generated via http://cci.lbl.gov/sginfo/ or via spacegroupdata.py in cif2cell.py
!Ref. https://fossies.org/diffs/cp2k/3.0_vs_4.1/src/topology_cif.F-diff.html
subroutine readcif(name,infomode)
use deftype
use defvar
use util
use fparser
implicit real*8 (a-h,o-z)
integer infomode
character(len=*) name
character :: c200tmp*200,c80tmp*80,c80tmp2*80,c80tmp3*80,symopstr(500)*40,strarr(20)*30,var(3)=(/'x','y','z'/)
real*8 vec1(3),vec2(3),vec1car(3),vec2car(3),val(3)
real*8,allocatable :: atmocc(:)
type(atomtype),allocatable :: a_dup(:)

ifiletype=17
ifPBC=3
open(10,file=name,status="old")

!!! Load cell information
if (infomode==0) write(*,*) "Loading cell information"
call loclabel(10,"_cell_length_a",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _cell_length_a field! Press ENTER button to exit"
    read(*,*);stop
end if
read(10,"(a)") c200tmp
call remove_parentheses(c200tmp)
read(c200tmp,*) c80tmp,asize
asize=asize/b2a
call loclabel(10,"_cell_length_b",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _cell_length_b field! Press ENTER button to exit"
    read(*,*);stop
end if
read(10,"(a)") c200tmp
call remove_parentheses(c200tmp)
read(c200tmp,*) c80tmp,bsize
bsize=bsize/b2a
call loclabel(10,"_cell_length_c",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _cell_length_c field! Press ENTER button to exit"
    read(*,*);stop
end if
read(10,"(a)") c200tmp
call remove_parentheses(c200tmp)
read(c200tmp,*) c80tmp,csize
csize=csize/b2a
call loclabel(10,"_cell_angle_alpha",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _cell_angle_alpha field! Press ENTER button to exit"
    read(*,*);stop
end if
read(10,"(a)") c200tmp
call remove_parentheses(c200tmp)
read(c200tmp,*) c80tmp,alpha
call loclabel(10,"_cell_angle_beta",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _cell_angle_beta field! Press ENTER button to exit"
    read(*,*);stop
end if
read(10,"(a)") c200tmp
call remove_parentheses(c200tmp)
read(c200tmp,*) c80tmp,beta
call loclabel(10,"_cell_angle_gamma",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _cell_angle_gamma field! Press ENTER button to exit"
    read(*,*);stop
end if
read(10,"(a)") c200tmp
call remove_parentheses(c200tmp)
read(c200tmp,*) c80tmp,gamma
call abc2cellv(asize,bsize,csize,alpha,beta,gamma)

!!! Load information of unique atoms
if (infomode==0) write(*,*) "Loading information of unique atoms"
call loclabel(10,"_atom_site_label",ifound)
if (ifound==0) then
    write(*,*) "Error: Unable to find _atom_site_label field! Press ENTER button to exit"
    read(*,*);stop
end if
do while(.true.)
    read(10,*) c80tmp
    if (c80tmp(1:1)/='_') exit
end do
ncenter_tmp=0
backspace(10)
do while(.true.) !Start loading atom part
    read(10,"(a)",iostat=ierror) c80tmp
    if (c80tmp==" ".or.index(c80tmp,'#')/=0.or.index(c80tmp,'loop_')/=0.or.ierror/=0) exit !.or.index(c80tmp,'_')/=0   Some atom names may contain _, so remove this criterion
    ncenter_tmp=ncenter_tmp+1
end do
if (allocated(a_tmp)) deallocate(a_tmp)
allocate(a_tmp(ncenter_tmp),atmocc(ncenter_tmp))
atmocc=1
write(*,"(a,i4)") " Number of symmetrically unique atoms:",ncenter_tmp

!Locate to "loop_" just before _atom_site_label
call loclabel(10,"_atom_site_label",ifound)
do while(.true.)
    backspace(10)
    read(10,"(a)") c80tmp
    if (index(c80tmp,"loop_")/=0) exit
    backspace(10)
end do
!Count how many atomic properties, and record index position of important labels
nlab=0
iocclab=0
do while(.true.)
    read(10,*) c80tmp
    if (index(c80tmp(1:1),'_')==0) exit
    nlab=nlab+1
    if (index(c80tmp,'_atom_site_label')/=0) iatmsitelab=nlab
    if (index(c80tmp,'_atom_site_type_symbol')/=0) iatmsitelab=nlab !If _atom_site_type_symbol is also given, use it prior to _atom_site_label
    if (index(c80tmp,'_atom_site_fract_x')/=0) ifrtxlab=nlab
    if (index(c80tmp,'_atom_site_fract_y')/=0) ifrtylab=nlab
    if (index(c80tmp,'_atom_site_fract_z')/=0) ifrtzlab=nlab
    if (index(c80tmp,'_atom_site_occupancy')/=0) iocclab=nlab
end do
backspace(10)
!Actual loading atomic information
do iatm=1,ncenter_tmp
    read(10,*) strarr(1:nlab)
    !Remove number and character after it in atom label if any
    call remove_parentheses(strarr(iatmsitelab))
    c80tmp=trim(strarr(iatmsitelab))
    do ichar=1,len_trim(c80tmp)
        if (iachar(c80tmp(ichar:ichar))>=48.and.iachar(c80tmp(ichar:ichar))<=57) then !This character is a digit
            c80tmp(ichar:)=" "
            exit
        end if
    end do
    a_tmp(iatm)%name=trim(c80tmp)
    !Detect element index
	call lc2uc(a_tmp(iatm)%name(1:1)) !Convert to upper case
	call uc2lc(a_tmp(iatm)%name(2:2)) !Convert to lower case
	do j=1,nelesupp
		if ( a_tmp(iatm)%name==ind2name(j) ) then
			a_tmp(iatm)%index=j
			a_tmp(iatm)%charge=j
			exit
		end if
	end do
    !Read fractional coordinates
    call remove_parentheses(strarr(ifrtxlab))
    call remove_parentheses(strarr(ifrtylab))
    call remove_parentheses(strarr(ifrtzlab))
    !write(*,"(i5,1x,a,1x,a,1x,a,1x,a)") iatm,trim(strarr(iatmsitelab)),trim(strarr(ifrtxlab)),trim(strarr(ifrtylab)),trim(strarr(ifrtzlab))
    read(strarr(ifrtxlab),*) a_tmp(iatm)%x
    read(strarr(ifrtylab),*) a_tmp(iatm)%y
    read(strarr(ifrtzlab),*) a_tmp(iatm)%z
    if (iocclab/=0) then
        call remove_parentheses(strarr(iocclab))
        read(strarr(iocclab),*,iostat=ierror) atmocc(iatm) !Some strange cif use ? for occupancy, in this case use 1.0 instead
        if (ierror/=0) atmocc(iatm)=1
    end if
end do
if (any(atmocc/=1)) then
    write(*,"(a)") " Warning: At least one atom has occupancy smaller than 1! All atoms will be loaded regardless of their occupancies"
    write(*,*) "Press ENTER button to continue"
    read(*,*)
end if

!!! Read symmetry opteration and replicate atoms
!Only do this according to explicitly recorded symmetry operation, while gview and VESTA also loads point group like follows and generate symmetry opterations
!_symmetry_space_group_name_H-M   'P 21/c'
if (infomode==0) write(*,*) "Loading symmetry opteration and replicate atoms"
call loclabel(10,"_symmetry_equiv_pos_as_xyz",ifound)
if (ifound==0) call loclabel(10,"_space_group_symop_operation_xyz",ifound)
if (ifound==1) then
    do while(.true.) !Load to loop_ prior to symmetry operation field
        backspace(10)
        read(10,"(a)") c80tmp
        if (index(c80tmp,"loop_")/=0) exit
        backspace(10)
    end do
    nlab=0
    do while(.true.)
        read(10,*) c80tmp
        if (index(c80tmp,'_')==0) exit
        nlab=nlab+1
        if (index(c80tmp,'_symmetry_equiv_pos_as_xyz')/=0.or.index(c80tmp,'_space_group_symop_operation_xyz')/=0) isymop=nlab
    end do
    backspace(10)
    !Read symmetry operation string
    nsymopstr=0 !Number of symmetry operations
    do while(.true.)
        read(10,"(a)",iostat=ierror) c80tmp
        if (c80tmp==" ".or.index(c80tmp,'#')/=0.or.index(c80tmp,'_')/=0.or.ierror/=0) exit
        nsymopstr=nsymopstr+1
        do ichar=1,len_trim(c80tmp) !Replace all ' with space, make coordinate variables to lower case
            if (c80tmp(ichar:ichar)=="'") c80tmp(ichar:ichar)=" "
            if (c80tmp(ichar:ichar)=="X") c80tmp(ichar:ichar)="x"
            if (c80tmp(ichar:ichar)=="Y") c80tmp(ichar:ichar)="y"
            if (c80tmp(ichar:ichar)=="Z") c80tmp(ichar:ichar)="z"
        end do
        c80tmp=adjustl(c80tmp)
        if (nlab==1) then
            symopstr(nsymopstr)=trim(c80tmp)
        else !Load the second term, assume at most there are two terms in a line
            itmp=index(c80tmp,' ')
            symopstr(nsymopstr)=trim(adjustl(c80tmp(itmp+1:)))
        end if
    end do
    write(*,"(a,i4)") " Number of symmetry operations:",nsymopstr

    allocate(a_dup(ncenter_tmp*nsymopstr))
    call initf(3)
    ncenter_dup=ncenter_tmp
    a_dup(1:ncenter_dup)=a_tmp
    ifdoPBCx=1;ifdoPBCy=1;ifdoPBCz=1 !Because some PBC routines must be used in following codes now, PBC must be forced to be enabled at this stage
    !Cycle each unique atom and apply symmetry operation in turn, add it as actual atom if it doesn't have superposition to existing atom
    do isymop=1,nsymopstr
        itmp=index(symopstr(isymop),",")
        jtmp=index(symopstr(isymop),",",back=.true.)
        c80tmp=symopstr(isymop)(:itmp-1)
        c80tmp2=symopstr(isymop)(itmp+1:jtmp-1)
        c80tmp3=symopstr(isymop)(jtmp+1:)
        !write(*,"(' Symmetry operation',i4,': ',a,1x,a,1x,a)") isymop,trim(c80tmp),trim(c80tmp2),trim(c80tmp3)
        call parsef(1,trim(c80tmp),var)
        call parsef(2,trim(c80tmp2),var)
        call parsef(3,trim(c80tmp3),var)
        do iatm=1,ncenter_tmp !Duplicate unique atoms via symmetry operations
            vec1(1)=a_tmp(iatm)%x !Unique atom in fractional coordinate
            vec1(2)=a_tmp(iatm)%y
            vec1(3)=a_tmp(iatm)%z
            vec2(1)=evalf(1,vec1) !Duplicated atom in fractional coordinate
            vec2(2)=evalf(2,vec1)
            vec2(3)=evalf(3,vec1)
            !write(*,"(' Atom',i5,/,' Org fract.:',3f12.6,' Bohr',/,' New fract.:',3f12.6,' Bohr')") iatm,vec1,vec2
            call fract2Cart(vec2,vec2car)
            call move_to_cell(vec2car,vec2car) !Duplicated atom in Cartesian coordinate in the cell

            !Compare with existing atoms
            do jatm=1,ncenter_dup
                vec1(1)=a_dup(jatm)%x
                vec1(2)=a_dup(jatm)%y
                vec1(3)=a_dup(jatm)%z
                call fract2Cart(vec1,vec1car)
                call move_to_cell(vec1car,vec1car) !Existing atom in Cartesian coordinate in the cell
                call nearest_dist(vec1car,vec2car,dist)
                if (dist<0.05D0) exit
            end do
            if (jatm==ncenter_dup+1) then
                ncenter_dup=ncenter_dup+1
                !write(*,"(' Added new atom, current number:',i5)") ncenter_dup
                a_dup(ncenter_dup)=a_tmp(iatm)
                a_dup(ncenter_dup)%x=vec2(1)
                a_dup(ncenter_dup)%y=vec2(2)
                a_dup(ncenter_dup)%z=vec2(3)
            end if
        end do
    end do
    ncenter=ncenter_dup
    allocate(a(ncenter))
    a=a_dup(1:ncenter_dup)

else !Symmetry operations are not explicitly given
    write(*,"(a)") " Note: Symmetry operations are not explicitly given in the .cif file, therefore symmetry operations will not be taken into account"
    ncenter=ncenter_tmp
    allocate(a(ncenter))
    a=a_tmp
end if
deallocate(a_tmp)
close(10)

!!! Make all atoms to Cartesian coordinate and wrap into the cell
do iatm=1,ncenter
    vec1(1)=a(iatm)%x
    vec1(2)=a(iatm)%y
    vec1(3)=a(iatm)%z
    call fract2Cart(vec1,vec2)
    call move_to_cell(vec2,vec2)
    a(iatm)%x=vec2(1)
    a(iatm)%y=vec2(2)
    a(iatm)%z=vec2(3)
end do

if (infomode==0) write(*,"(' Totally',i8,' atoms')") ncenter
call guessnelec
end subroutine

!!---------- Interface of outputting cif file
subroutine outcif_wrapper
use util
use defvar
character*200 outname,c200tmp
call path2filename(filename,c200tmp)
write(*,*) "Input path for outputting cif file, e.g. C:\ltwd.cif"
write(*,"(a)") " If press ENTER button directly,the system will be exported to "//trim(c200tmp)//".cif in current folder"
read(*,"(a)") outname
if (outname==" ") outname=trim(c200tmp)//".cif"
call outcif(outname,10)
end subroutine
!!---------- Output current coordinate to cif file
subroutine outcif(outcifname,ifileid)
use defvar
implicit real*8 (a-h,o-z)
character(len=*) outcifname
integer i,ifileid
real*8 rcoord(3),fcoord(3)
open(ifileid,file=outcifname,status="replace")
write(ifileid,"(a)") "#Generated by Multiwfn"
write(ifileid,"(a,f8.3)") "data_system"
call getcellabc(asize,bsize,csize,alpha,beta,gamma)
write(ifileid,"(a,f8.3)") "_cell_angle_alpha",alpha
write(ifileid,"(a,f8.3)") "_cell_angle_beta ",beta
write(ifileid,"(a,f8.3)") "_cell_angle_gamma",gamma
write(ifileid,"(a,f12.6)") "_cell_length_a",asize
write(ifileid,"(a,f12.6)") "_cell_length_b",bsize
write(ifileid,"(a,f12.6)") "_cell_length_c",csize
write(ifileid,"(a)") "loop_"
write(ifileid,"(a)") "_symmetry_equiv_pos_as_xyz"
write(ifileid,"(a)") "x,y,z"
write(ifileid,"(a)") "loop_"
write(ifileid,"(a)") "_atom_site_label"
write(ifileid,"(a)") "_atom_site_fract_x"
write(ifileid,"(a)") "_atom_site_fract_y"
write(ifileid,"(a)") "_atom_site_fract_z"
do i=1,ncenter
    rcoord(1)=a(i)%x
    rcoord(2)=a(i)%y
    rcoord(3)=a(i)%z
    call Cart2fract(rcoord,fcoord)
	write(ifileid,"(a,3f16.8)") ind2name(a(i)%index),fcoord(:)
end do

close(ifileid)
write(*,*) "Exporting cif file finished!"
end subroutine

!=======================================================================
!=======================================================================
!!!!!!!! Load parameters in settings.ini when boot up multiwfn !!!!!!!!!
!=======================================================================
!=======================================================================
subroutine loadsetting
use defvar
use util
implicit real*8 (a-h,o-z)
character c80tmp*80,c200tmp*200,settingpath*200
!Set default color of atomic spheres
atm3Dclr(:,1)=0.85D0
atm3Dclr(:,2)=0.6D0
atm3Dclr(:,3)=0.5D0
atm3Dclr(0,:)=(/0.3D0,  0.8D0,  0.85D0 /) !Bq
atm3Dclr(1,:)=(/0.95D0, 0.95D0, 0.95D0/) !H
atm3Dclr(5,:)=(/0.95D0, 0.7D0,  0.7D0 /) !B
atm3Dclr(6,:)=(/0.85D0, 0.85D0, 0.55D0/) !C
atm3Dclr(7,:)=(/0.5D0,  0.5D0,  1.0D0 /) !N
atm3Dclr(8,:)=(/1.0D0,  0.2D0,  0.2D0 /) !O
atm3Dclr(9,:)=(/0.6D0,  0.9D0,  0.9D0 /) !F
atm3Dclr(15,:)=(/0.9D0, 0.4D0,  0.0D0 /) !P
atm3Dclr(16,:)=(/0.9D0, 0.7D0,  0.1D0 /) !S
atm3Dclr(17,:)=(/0.1D0, 0.9D0,  0.1D0 /) !Cl

call getarg_str("-set",settingpath,ifound)

if (ifound==0) then
    inquire(file="settings.ini",exist=alive)
    if (alive==.true.) then
	    settingpath="settings.ini"
    else if (alive==.false.) then
	    call getenv("Multiwfnpath",c80tmp)
	    if (isys==1) then
		    settingpath=trim(c80tmp)//"\settings.ini"
	    else if (isys==2) then
		    settingpath=trim(c80tmp)//"/settings.ini"
	    end if
	    inquire(file=settingpath,exist=alive)
	    if (alive==.false.) then
		    write(*,"(a)") " Warning: ""settings.ini"" was found neither in current folder nor in the path defined by ""Multiwfnpath"" &
		    environment variable. Now using default settings instead"
		    write(*,*)
		    return
	    end if
    end if
end if

open(20,file=settingpath,status="old")

! Below are the parameters can affect calculation results
call getarg_int("-uf",iuserfunc,ifound)
if (ifound==0) then
    call loclabel(20,'iuserfunc=',ifound)
    if (ifound==1) read(20,*) c80tmp,iuserfunc
end if
call loclabel(20,'refxyz=',ifound)
if (ifound==1) read(20,*) c80tmp,refx,refy,refz
call loclabel(20,'iDFTxcsel=',ifound)
if (ifound==1) read(20,*) c80tmp,iDFTxcsel
call loclabel(20,'iKEDsel=',ifound)
if (ifound==1) read(20,*) c80tmp,iKEDsel
call loclabel(20,'uservar=',ifound)
if (ifound==1) read(20,*) c80tmp,uservar
call loclabel(20,'uservar2=',ifound)
if (ifound==1) read(20,*) c80tmp,uservar2
call loclabel(20,'ivdwprobe=',ifound)
if (ifound==1) read(20,*) c80tmp,ivdwprobe
call loclabel(20,'paircorrtype=',ifound)
if (ifound==1) read(20,*) c80tmp,paircorrtype
call loclabel(20,'pairfunctype=',ifound)
if (ifound==1) read(20,*) c80tmp,pairfunctype
call loclabel(20,'iautointgrid=',ifound)
if (ifound==1) read(20,*) c80tmp,iautointgrid
call loclabel(20,'radpot=',ifound)
if (ifound==1) read(20,*) c80tmp,radpot
call loclabel(20,'sphpot=',ifound)
if (ifound==1) read(20,*) c80tmp,sphpot
call loclabel(20,'radcut=',ifound)
if (ifound==1) read(20,*) c80tmp,radcut
call loclabel(20,'expcutoff=',ifound)
if (ifound==1) read(20,*) c80tmp,expcutoff
call loclabel(20,'expcutoff_PBC=',ifound)
if (ifound==1) read(20,*) c80tmp,expcutoff_PBC
call loclabel(20,'RDG_maxrho=',ifound)
if (ifound==1) read(20,*) c80tmp,RDG_maxrho
call loclabel(20,'RDGprodens_maxrho=',ifound)
if (ifound==1) read(20,*) c80tmp,RDGprodens_maxrho
call loclabel(20,'IRI_rhocut=',ifound)
if (ifound==1) read(20,*) c80tmp,IRI_rhocut
call loclabel(20,'ELF_addminimal=',ifound)
if (ifound==1) read(20,*) c80tmp,ELF_addminimal
call loclabel(20,'ELFLOL_type=',ifound)
if (ifound==1) read(20,*) c80tmp,ELFLOL_type
call loclabel(20,'iALIEdecomp=',ifound)
if (ifound==1) read(20,*) c80tmp,iALIEdecomp
call loclabel(20,'srcfuncmode=',ifound)
if (ifound==1) read(20,*) c80tmp,srcfuncmode
call loclabel(20,'atomdenscut=',ifound)
if (ifound==1) read(20,*) c80tmp,atomdenscut
call loclabel(20,'aug1D=',ifound)
if (ifound==1) read(20,*) c80tmp,aug1D
call loclabel(20,'aug2D=',ifound)
if (ifound==1) read(20,*) c80tmp,aug2D
call loclabel(20,'aug3D=',ifound)
if (ifound==1) read(20,*) c80tmp,aug3D
call loclabel(20,'num1Dpoints=',ifound)
if (ifound==1) read(20,*) c80tmp,num1Dpoints
call loclabel(20,'nprevorbgrid=',ifound)
if (ifound==1) read(20,*) c80tmp,nprevorbgrid
call loclabel(20,'bndordthres=',ifound)
if (ifound==1) read(20,*) c80tmp,bndordthres
call loclabel(20,'compthres=',ifound)
if (ifound==1) read(20,*) c80tmp,compthres
call loclabel(20,'compthresCDA=',ifound)
if (ifound==1) read(20,*) c80tmp,compthresCDA
call loclabel(20,'iCDAcomp=',ifound)
if (ifound==1) read(20,*) c80tmp,iCDAcomp
call loclabel(20,'ispheratm=',ifound)
if (ifound==1) read(20,*) c80tmp,ispheratm
call loclabel(20,'laplfac=',ifound)
if (ifound==1) read(20,*) c80tmp,laplfac
call loclabel(20,'ipolarpara=',ifound)
if (ifound==1) read(20,*) c80tmp,ipolarpara
call loclabel(20,'ishowchgtrans=',ifound)
if (ifound==1) read(20,*) c80tmp,ishowchgtrans
call loclabel(20,'uESEinp=',ifound)
if (ifound==1) read(20,*) c80tmp,uESEinp
call loclabel(20,'SpherIVgroup=',ifound)
if (ifound==1) read(20,*) c80tmp,SpherIVgroup
call loclabel(20,'MCvolmethod=',ifound)
if (ifound==1) read(20,*) c80tmp,MCvolmethod
call loclabel(20,'readEDF=',ifound)
if (ifound==1) read(20,*) c80tmp,readEDF
call loclabel(20,'isupplyEDF=',ifound)
if (ifound==1) read(20,*) c80tmp,isupplyEDF
call loclabel(20,'idelvirorb=',ifound)
if (ifound==1) read(20,*) c80tmp,idelvirorb
call loclabel(20,'ifchprog=',ifound)
if (ifound==1) read(20,*) c80tmp,ifchprog
call loclabel(20,'ishowptESP=',ifound)
if (ifound==1) read(20,*) c80tmp,ishowptESP
call loclabel(20,'imolsurparmode=',ifound)
if (ifound==1) read(20,*) c80tmp,imolsurparmode
call loclabel(20,'steric_addminimal=',ifound)
if (ifound==1) read(20,*) c80tmp,steric_addminimal
call loclabel(20,'steric_potcutrho=',ifound)
if (ifound==1) read(20,*) c80tmp,steric_potcutrho
call loclabel(20,'steric_potcons=',ifound)
if (ifound==1) read(20,*) c80tmp,steric_potcons
call loclabel(20,'NICSnptlim=',ifound)
if (ifound==1) read(20,*) c80tmp,NICSnptlim
call loclabel(20,'iplaneextdata=',ifound)
if (ifound==1) read(20,*) c80tmp,iplaneextdata
call loclabel(20,'igenP=',ifound)
if (ifound==1) read(20,*) c80tmp,igenP
call loclabel(20,'iloadasCart=',ifound)
if (ifound==1) read(20,*) c80tmp,iloadasCart
call loclabel(20,'iloadGaugeom=',ifound)
if (ifound==1) read(20,*) c80tmp,iloadGaugeom
call loclabel(20,'maxloadexc=',ifound)
if (ifound==1) read(20,*) c80tmp,maxloadexc
call loclabel(20,'iprintLMOorder=',ifound)
if (ifound==1) read(20,*) c80tmp,iprintLMOorder
call loclabel(20,'iMCBOtype=',ifound)
if (ifound==1) read(20,*) c80tmp,iMCBOtype
call loclabel(20,'ibasinlocmin=',ifound)
if (ifound==1) read(20,*) c80tmp,ibasinlocmin
call loclabel(20,'ESPrhoiso=',ifound)
if (ifound==1) read(20,*) c80tmp,ESPrhoiso
call getarg_float("-ESPrhoiso",ESPrhoiso,ifound)
call loclabel(20,'ESPrhonlay=',ifound)
if (ifound==1) read(20,*) c80tmp,ESPrhonlay
call getarg_int("-ESPrhonlay",ESPrhonlay,ifound)
call loclabel(20,'PBCnxnynz=',ifound)
if (ifound==1) read(20,*) c80tmp,PBCnx_in,PBCny_in,PBCnz_in
call loclabel(20,'ifdoPBCxyz=',ifound)
if (ifound==1) read(20,*) c80tmp,ifdoPBCx_in,ifdoPBCy_in,ifdoPBCz_in

!Below are the parameters involved in plotting
call loclabel(20,'plotwinsize3D=',ifound)
if (ifound==1) read(20,*) c80tmp,plotwinsize3D
call loclabel(20,'imodlayout=',ifound)
if (ifound==1) read(20,*) c80tmp,imodlayout
call loclabel(20,'symbolsize=',ifound)
if (ifound==1) read(20,*) c80tmp,symbolsize
call loclabel(20,'pleatmlabsize=',ifound)
if (ifound==1) read(20,*) c80tmp,pleatmlabsize
call loclabel(20,'disshowlabel=',ifound)
if (ifound==1) read(20,*) c80tmp,disshowlabel
call loclabel(20,'iatom_on_plane_far=',ifound)
if (ifound==1) read(20,*) c80tmp,iatom_on_plane_far
call loclabel(20,'iatmlabtype=',ifound)
if (ifound==1) read(20,*) c80tmp,iatmlabtype
call loclabel(20,'iatmlabtype3D=',ifound)
if (ifound==1) read(20,*) c80tmp,iatmlabtype3D
call loclabel(20,'graphformat=',ifound)
if (ifound==1) read(20,*) c80tmp,graphformat
call loclabel(20,'graph1Dsize=',ifound)
if (ifound==1) read(20,*) c80tmp,graph1Dwidth,graph1Dheight
call loclabel(20,'graph2Dsize=',ifound)
if (ifound==1) read(20,*) c80tmp,graph2Dwidth,graph2Dheight
call loclabel(20,'graph3Dsize=',ifound)
if (ifound==1) read(20,*) c80tmp,graph3Dwidth,graph3Dheight
call loclabel(20,'numdigxyz=',ifound)
if (ifound==1) read(20,*) c80tmp,numdigx,numdigy,numdigz
call loclabel(20,'numdiglinexy=',ifound)
if (ifound==1) read(20,*) c80tmp,numdiglinex,numdigliney
call loclabel(20,'numdigctr=',ifound)
if (ifound==1) read(20,*) c80tmp,numdigctr
call loclabel(20,'fillcoloritpxy=',ifound)
if (ifound==1) read(20,*) c80tmp,fillcoloritpx,fillcoloritpy
call loclabel(20,'itransparent=',ifound)
if (ifound==1) read(20,*) c80tmp,itransparent
call loclabel(20,'isurfstyle=',ifound)
if (ifound==1) read(20,*) c80tmp,isurfstyle
call loclabel(20,'bondRGB=',ifound)
if (ifound==1) read(20,*) c80tmp,bondclrR,bondclrG,bondclrB
call loclabel(20,'atmlabRGB=',ifound)
if (ifound==1) read(20,*) c80tmp,atmlabclrR,atmlabclrG,atmlabclrB
call loclabel(20,'CP_RGB=',ifound)
if (ifound==1) read(20,*) c80tmp,CP3n3RGB,CP3n1RGB,CP3p1RGB,CP3p3RGB
call loclabel(20,'CP_RGB_2D=',ifound)
if (ifound==1) read(20,*) c80tmp,CP3n3RGB_2D,CP3n1RGB_2D,CP3p1RGB_2D,CP3p3RGB_2D
call loclabel(20,'isoRGB_same=',ifound)
if (ifound==1) then
    read(20,*) c80tmp,clrRcub1same,clrGcub1same,clrBcub1same
    clrRcub1samemeshpt=clrRcub1same;clrGcub1samemeshpt=clrGcub1same;clrBcub1samemeshpt=clrBcub1same
end if
call loclabel(20,'isoRGB_oppo=',ifound)
if (ifound==1) then
    read(20,*) c80tmp,clrRcub1oppo,clrGcub1oppo,clrBcub1oppo
    clrRcub1oppomeshpt=clrRcub1oppo;clrGcub1oppomeshpt=clrGcub1oppo;clrBcub1oppomeshpt=clrBcub1oppo
end if
call loclabel(20,'atmcolorfile=',ifound) !Set atom 3D color either according to external file or default setting
if (ifound==1) then
	read(20,*) c80tmp,c200tmp
	inquire(file=c200tmp,exist=alive)
	if (index(c200tmp,"none")==0.and.alive) then
		write(*,"(' Note: Loading atom color settings from ',a)") trim(c200tmp)
		open(21,file=c200tmp,status="old")
		do iele=0,nelesupp
			read(21,*) inouse,atm3Dclr(iele,:)
		end do
		close(21)
	end if
end if
!Below are parameters about system
call getarg_int("-nt",nthreads,ifound)
if (ifound==0) then
    call loclabel(20,'nthreads=',ifound)
    if (ifound==1) read(20,*) c80tmp,nthreads
end if
call loclabel(20,'ompstacksize=',ifound)
if (ifound==1) read(20,*) c80tmp,ompstacksize
call loclabel(20,'gaupath=',ifound)
if (ifound==1) read(20,*) c200tmp,gaupath
call loclabel(20,'cubegenpath=',ifound)
if (ifound==1) read(20,*) c200tmp,cubegenpath
call loclabel(20,'cubegendenstype=',ifound)
if (ifound==1) read(20,*) c200tmp,cubegendenstype
call loclabel(20,'formchkpath=',ifound)
if (ifound==1) read(20,*) c200tmp,formchkpath
call loclabel(20,'orcapath=',ifound)
if (ifound==1) read(20,*) c200tmp,orcapath
call loclabel(20,'orca_2mklpath=',ifound)
if (ifound==1) read(20,*) c200tmp,orca_2mklpath
call testarg("-silent",isilent)
if (isilent==0) then
    call loclabel(20,'isilent=',ifound)
    if (ifound==1) read(20,*) c80tmp,isilent
end if
call loclabel(20,'iESPcode=',ifound)
if (ifound==1) read(20,*) c80tmp,iESPcode
call loclabel(20,'outmedinfo=',ifound)
if (ifound==1) read(20,*) c80tmp,outmedinfo
call loclabel(20,'iwfntmptype=',ifound)
if (ifound==1) read(20,*) c80tmp,iwfntmptype
call loclabel(20,'iaddprefix=',ifound)
if (ifound==1) read(20,*) c80tmp,iaddprefix
call loclabel(20,'ispecial=',ifound)
if (ifound==1) read(20,*) c80tmp,ispecial
!The last opened file name
call loclabel(20,'lastfile=',ifound)
if (ifound==1) read(20,"(10x,a)") lastfile
close(20)

!Load additional arguments

end subroutine

!!------- Delete files, cannot delete folder
subroutine delfile(delname)
use defvar
character(len=*) delname
character command*200
if (isys==1) then
    command="del /Q "//trim(delname)//" 2> NUL" !/Q means do not need confirm when there is *. "2> NUL" redirects error (e.g. unable to find file) to black hole
else if (isys==2) then
    command="rm -f "//trim(delname)
end if
write(*,*) "Deleting "//trim(delname)
call system(trim(command))
end subroutine

max_stars_repo_name: ruixingw/Multiwfn-mirror

max_issues_repo_name: ruixingw/Multiwfn-mirror

max_forks_repo_name: ruixingw/Multiwfn-mirror