From 331ee4c3f7ea5753009d30cd857a681d6db62da4 Mon Sep 17 00:00:00 2001 From: FulgurIgor Date: Tue, 1 Dec 2020 21:15:54 +0300 Subject: [PATCH] Fix gFortran compilation --- src/0123dim.f90 | 4 ++-- src/AdNDP.f90 | 2 +- src/CDA.f90 | 4 ++-- src/DOS.f90 | 4 ++-- src/GUI.f90 | 8 ++++---- src/LSB.f90 | 2 +- src/Makefile | 11 +++++------ src/Makefile_noGUI | 11 +++++------ src/Multiwfn.f90 | 12 ++++++------ src/basin.f90 | 22 +++++++++++----------- src/define.f90 | 28 +++++++++++++++++++++++----- src/excittrans.f90 | 8 ++++---- src/fileIO.f90 | 14 ++++++++------ src/function.f90 | 2 +- src/otherfunc.f90 | 2 +- src/otherfunc2.f90 | 2 +- src/plot.f90 | 4 ++-- src/population.f90 | 17 +++++++++-------- src/spectrum.f90 | 8 ++++---- src/sub.f90 | 22 +++++++++++----------- src/surfana.f90 | 4 ++-- src/util.f90 | 2 +- 22 files changed, 106 insertions(+), 87 deletions(-) diff --git a/src/0123dim.f90 b/src/0123dim.f90 index 884da57..194f973 100644 --- a/src/0123dim.f90 +++ b/src/0123dim.f90 @@ -215,7 +215,7 @@ subroutine study1dim alive=.false. if (cubegenpath/=" ".and.ifiletype==1.and.isel==12) then inquire(file=cubegenpath,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(a)") " Note: Albeit current file type is fch/fchk/chk and ""cubegenpath"" parameter in settings.ini has been defined, & the cubegen cannot be found, therefore electrostatic potential will still be calculated using internal code of Multiwfn" end if @@ -2405,7 +2405,7 @@ subroutine setcontour do while(.true.) read(*,"(a)") extctrsetting inquire(file=extctrsetting,exist=alive) - if (alive==.true.) exit + if (alive) exit write(*,*) "File not found, input again" end do open(10,file=extctrsetting,status="old") diff --git a/src/AdNDP.f90 b/src/AdNDP.f90 index d5a2298..da054c7 100644 --- a/src/AdNDP.f90 +++ b/src/AdNDP.f90 @@ -667,7 +667,7 @@ subroutine AdNDP write(*,*) "Note: If the suffix is .47, the Fock matrix will be directly loaded from it" read(*,"(a)") c200tmp inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Error: Unable to find this file!" cycle end if diff --git a/src/CDA.f90 b/src/CDA.f90 index 5c36ffa..94506b8 100644 --- a/src/CDA.f90 +++ b/src/CDA.f90 @@ -1297,7 +1297,7 @@ subroutine plotintdiag(status,ifrag,jfrag,nCDAfrag,nmoCDA,FOcp,nmo0,nmo1,nmo2,oc ilastplotted=0 cycle end if - if ((idrawMObar==2.or.idrawMObar==3).and.FO1involveconn(iorb)==.false.) cycle + if ((idrawMObar==2.or.idrawMObar==3).and..not.FO1involveconn(iorb)) cycle call solid !Use solid line to plot occupied orbital bars, use dashed line to plot virtual orbital bars if (occ1(iorb)==0) call dash call rline(xlow1,eneval,xhigh1,eneval) @@ -1325,7 +1325,7 @@ subroutine plotintdiag(status,ifrag,jfrag,nCDAfrag,nmoCDA,FOcp,nmo0,nmo1,nmo2,oc ilastplotted=0 cycle end if - if ((idrawMObar==2.or.idrawMObar==3).and.FO2involveconn(iorb)==.false.) cycle + if ((idrawMObar==2.or.idrawMObar==3).and..not.FO2involveconn(iorb)) cycle call solid if (occ2(iorb)==0) call dash call rline(xlow2,eneval,xhigh2,eneval) diff --git a/src/DOS.f90 b/src/DOS.f90 index ffc8570..778dbe5 100644 --- a/src/DOS.f90 +++ b/src/DOS.f90 @@ -39,7 +39,7 @@ subroutine DOS character clegend*960 !Legend strings. (10+2) lines * 80 character per line integer :: legendx=400,legendy=160 character :: TDOSstring*80="TDOS",OPDOSstring*80="OPDOS",graphformat_old*4 -character :: PDOSstring(nfragmax)*80=(/"PDOS frag.1","PDOS frag.2","PDOS frag.3","PDOS frag.4","PDOS frag.5","PDOS frag.6","PDOS frag.7","PDOS frag.8","PDOS frag.9","PDOS frag.10"/) +character :: PDOSstring(nfragmax)*80=(/"PDOS frag.1 ","PDOS frag.2 ","PDOS frag.3 ","PDOS frag.4 ","PDOS frag.5 ","PDOS frag.6 ","PDOS frag.7 ","PDOS frag.8 ","PDOS frag.9 ","PDOS frag.10"/) integer :: ishowPDOSline(nfragmax),ishowPDOScurve(nfragmax),icurvewidth=3,ilinewidth=2,intarr(2) integer :: iclrPDOS(nfragmax)=(/ 1,3,10,14,12,9,13,11,6,7 /) !Below are used for defining fragments. For Mulliken/SCPA, they correspond to basis function, while for Hirshfeld/Becke, they correspond to atom indices @@ -339,7 +339,7 @@ subroutine DOS read(*,"(a)") c200tmp if (c200tmp==" ") c200tmp="DOS.dat" inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Error: Cannot find the file! Press ENTER button to return" read(*,*) cycle diff --git a/src/GUI.f90 b/src/GUI.f90 index 91a7513..81c56e0 100644 --- a/src/GUI.f90 +++ b/src/GUI.f90 @@ -1037,7 +1037,7 @@ subroutine miniGUI !Show all orbitals subroutine showorbinfo(id) integer,intent (in) :: id -character*3 :: orbtype(0:2)=(/ "A+B"," A"," B" /) +character*3 :: orbtype(0:2)=(/ "A+B"," A "," B " /) character*6 :: symstr symstr=" " naorb=count(MOtype==1) @@ -1066,7 +1066,7 @@ subroutine showorbinfo(id) !Show orbitals up to LUMO+10, works for wfntype==0,1,2 subroutine showorbinfo2(id) integer,intent (in) :: id -character*3 :: orbtype(0:2)=(/ "A+B"," A"," B" /) +character*3 :: orbtype(0:2)=(/ "A+B"," A "," B " /) character*6 :: symstr symstr=" " naorb=count(MOtype==1) @@ -1117,7 +1117,7 @@ subroutine showorbinfo2(id) !Show all occupied orbitals subroutine showorbinfo3(id) integer,intent (in) :: id -character*3 :: orbtype(0:2)=(/ "A+B"," A"," B" /) +character*3 :: orbtype(0:2)=(/ "A+B"," A "," B " /) character*6 :: symstr symstr=" " naorb=count(MOtype==1) @@ -1461,7 +1461,7 @@ subroutine showorbsel(id,iorb) use function integer id,iorb real*8 molxlen,molylen,molzlen -character*3 :: orbtype(0:2)=(/ "A+B"," A"," B" /) +character*3 :: orbtype(0:2)=(/ "A+B"," A "," B " /) character*6 :: symstr ! Set grid for calculating cube data molxlen=(maxval(a%x)-minval(a%x))+2*aug3D diff --git a/src/LSB.f90 b/src/LSB.f90 index d82cb43..dcfc8d8 100644 --- a/src/LSB.f90 +++ b/src/LSB.f90 @@ -846,7 +846,7 @@ subroutine integratebasinmix_LSB rnowy=yarr(iy) do ix=2,nx-1 rnowx=xarr(ix) - if (interbasgrid(ix,iy,iz)==.false.) cycle + if (.not.interbasgrid(ix,iy,iz)) cycle nrefine=1 ndiv=nrefine**3 orgxref=rnowx-dx/2 !Take corner position as original point of microcycle diff --git a/src/Makefile b/src/Makefile index 0ab902e..2219ae5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,11 +1,10 @@ -SIMD = -msse3 -OPT = -O2 -qopenmp -qopenmp-link=static -threads -qopt-matmul $(SIMD) -diag-disable 8290,8291,6371,10316 -fpp -mkl -static-intel +OPT = -O2 -fopenmp -ffree-line-length-none -cpp #Options in the next line is for debugging purpose #OPT = -O0 -qopenmp -diag-disable 8290,8291,6371 -threads -qopenmp-link=static -debug all -g -traceback -check all -fstack-protector -fpp -mkl -static-intel -LIB = ./dislin_d-11.0.a -lXm -lXt -lX11 -lGL #Works for CentOS 7.x -FC = ifort -EXE = Multiwfn +LIB = ./dislin_d-11.0.a -lXm -lXt -lX11 -lGL -lblas -llapack #Works for CentOS 7.x +FC = gfortran +EXE = gMultiwfn LIBRETAPATH = ./libreta_slow objects = define.o util.o plot.o Bspline.o sym.o libreta.o function.o GUI.o sub.o integral.o Lebedev-Laikov.o \ @@ -168,7 +167,7 @@ ean.o: ${LIBRETAPATH}/ean.f90 hrr_012345.o eanvrr_012345.o boysfunc.o ${LIBRETAP $(FC) $(OPT) -c ${LIBRETAPATH}/ean.f90 hrr_012345.o: ${LIBRETAPATH}/hrr_012345.f90 - $(FC) -O2 -diag-disable 6843 $(SIMD) -c ${LIBRETAPATH}/hrr_012345.f90 + $(FC) $(OPT) -c ${LIBRETAPATH}/hrr_012345.f90 eanvrr_012345.o: ${LIBRETAPATH}/eanvrr_012345.f90 boysfunc.o $(FC) $(OPT) -c ${LIBRETAPATH}/eanvrr_012345.f90 diff --git a/src/Makefile_noGUI b/src/Makefile_noGUI index 9c34f0e..ef68afb 100644 --- a/src/Makefile_noGUI +++ b/src/Makefile_noGUI @@ -1,9 +1,8 @@ -SIMD = -msse3 -OPT = -O2 -qopenmp -qopenmp-link=static -threads -qopt-matmul $(SIMD) -diag-disable 8290,8291,6371,10316 -fpp -mkl -static-intel +OPT = -O2 -fopenmp -ffree-line-length-none -cpp -LIB = -FC = ifort -EXE = Multiwfn +LIB = -lblas -llapack +FC = gfortran +EXE = gMultiwfn LIBRETAPATH = ./libreta_slow objects = define.o util.o Bspline.o sym.o libreta.o function.o sub.o integral.o Lebedev-Laikov.o \ @@ -157,7 +156,7 @@ ean.o: ${LIBRETAPATH}/ean.f90 hrr_012345.o eanvrr_012345.o boysfunc.o ${LIBRETAP $(FC) $(OPT) -c ${LIBRETAPATH}/ean.f90 hrr_012345.o: ${LIBRETAPATH}/hrr_012345.f90 - $(FC) -O2 -diag-disable 6843 $(SIMD) -c ${LIBRETAPATH}/hrr_012345.f90 + $(FC) $(OPT) -c ${LIBRETAPATH}/hrr_012345.f90 eanvrr_012345.o: ${LIBRETAPATH}/eanvrr_012345.f90 boysfunc.o $(FC) $(OPT) -c ${LIBRETAPATH}/eanvrr_012345.f90 diff --git a/src/Multiwfn.f90 b/src/Multiwfn.f90 index 0cbe257..8b68d5e 100644 --- a/src/Multiwfn.f90 +++ b/src/Multiwfn.f90 @@ -7,7 +7,7 @@ program multiwfn real*8,allocatable :: tmparr(:),tmparr2(:),tmpmat(:,:),tmpmat2(:,:) !For debug purpose integer,allocatable :: tmparri(:),tmparr2i(:),tmpmati(:,:),tmpmat2i(:,:) -call kmp_set_warnings_off() !In rare case, "Cannot open message catalog "1041\libiomp5ui.dll"" may occurs, this calling avoid this problem, or user should set KMP_WARNINGS environment variable to 0 +!call kmp_set_warnings_off() !In rare case, "Cannot open message catalog "1041\libiomp5ui.dll"" may occurs, this calling avoid this problem, or user should set KMP_WARNINGS environment variable to 0 !Try to get input file name from argument, which should be the first argument filename=" " @@ -40,13 +40,13 @@ program multiwfn !For Linux/MacOS version, it seems the only way to set stacksize of each thread is to define KMP_STACKSIZE environment variable if (isys==1) then !Set via ompstacksize in settings.ini - call KMP_SET_STACKSIZE_S(ompstacksize) + !call KMP_SET_STACKSIZE_S(ompstacksize) else if (isys==2) then !The size should have been defined by KMP_STACKSIZE CALL getenv('KMP_STACKSIZE',c200tmp) if (c200tmp==" ") write(*,"(/,a)") " Warning: You should set ""KMP_STACKSIZE"" environment variable as mentioned in Section 2.1.2 of Multiwfn manual!" end if !write(*,"(' OpenMP stacksize for each thread: ',f10.2,' MB')") dfloat(KMP_GET_STACKSIZE_S())/1024/1024 -call mkl_set_num_threads(nthreads) !Use this to set number of cores used in MKL library (e.g. function matmul_blas) +!call mkl_set_num_threads(nthreads) !Use this to set number of cores used in MKL library (e.g. function matmul_blas) write(*,*) @@ -87,9 +87,9 @@ program multiwfn end do !Write current opened file to "lastfile" in settings.ini inquire(file="settings.ini",exist=alive) - if (alive==.true.) then + if (alive) then settingpath="settings.ini" - else if (alive==.false.) then + else if (.not.alive) then call getenv("Multiwfnpath",c200tmp) if (isys==1) then settingpath=trim(c200tmp)//"\settings.ini" @@ -543,7 +543,7 @@ program multiwfn else if (i==13) then allocate(tmpmat(ncenter,ncenter)) inquire(file="bndmat.txt",exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Cannot find the bndmat.txt in current folder!" cycle end if diff --git a/src/basin.f90 b/src/basin.f90 index d3f3248..1e3e656 100644 --- a/src/basin.f90 +++ b/src/basin.f90 @@ -175,7 +175,7 @@ subroutine basinana if (igrid==1) then continue else if (igrid==2) then - where (interbasgrid==0) cubmattmp=0 + where (.not.interbasgrid) cubmattmp=0 else if (igrid==3) then if (ifuncbasin==1) then !The cubmat already records electron density where(cubmat<0.001D0) cubmattmp=0 @@ -518,7 +518,7 @@ while the atomic indices correspond to the raw attractor indices. The atomic cha write(*,"(' The number of unassigned grids:',i12)") numunassign numgotobound=count(gridbas(2:nx-1,2:ny-1,2:nz-1)==-1) write(*,"(' The number of grids travelled to box boundary:',i12)") numgotobound - where (grdposneg==.false.) cubmat=-cubmat !Recover original grid data + where (.not.grdposneg) cubmat=-cubmat !Recover original grid data deallocate(grdposneg) do iatt=1,numatt !Eliminate the attractors with very low value @@ -551,7 +551,7 @@ while the atomic indices correspond to the raw attractor indices. The atomic cha call clusdegenatt(0) !Cluster degenerate attractors as "real attractors" and calculate average coordinate and value for the real attractors call detectinterbasgrd(6) !Detect interbasin grids - numinterbas=count(interbasgrid==.true.) + numinterbas=count(interbasgrid) write(*,"(' The number of interbasin grids:',i12)") numinterbas else if (isel==2) then @@ -758,7 +758,7 @@ subroutine generatebasin(igridmethod) attgrid(numatt,1)=inowx attgrid(numatt,2)=inowy attgrid(numatt,3)=inowz - if (grdposneg(inowx,inowy,inowz)==.true.) then + if (grdposneg(inowx,inowy,inowz)) then write(*,"(i8,3f14.8,f20.8)") numatt,(orgx+(inowx-1)*dx)*b2a,(orgy+(inowy-1)*dy)*b2a,(orgz+(inowz-1)*dz)*b2a,cubmat(inowx,inowy,inowz) else !This grid should has negative value write(*,"(i8,3f14.8,f20.8)") numatt,(orgx+(inowx-1)*dx)*b2a,(orgy+(inowy-1)*dy)*b2a,(orgz+(inowz-1)*dz)*b2a,-cubmat(inowx,inowy,inowz) @@ -859,7 +859,7 @@ subroutine generatebasin(igridmethod) attgrid(numatt,1)=inowx attgrid(numatt,2)=inowy attgrid(numatt,3)=inowz - if (grdposneg(inowx,inowy,inowz)==.true.) then + if (grdposneg(inowx,inowy,inowz)) then write(*,"(i8,3f14.8,f20.8)") numatt,(orgx+(inowx-1)*dx)*b2a,(orgy+(inowy-1)*dy)*b2a,(orgz+(inowz-1)*dz)*b2a,cubmat(inowx,inowy,inowz) else !This grid should has negative value write(*,"(i8,3f14.8,f20.8)") numatt,(orgx+(inowx-1)*dx)*b2a,(orgy+(inowy-1)*dy)*b2a,(orgz+(inowz-1)*dz)*b2a,-cubmat(inowx,inowy,inowz) @@ -932,7 +932,7 @@ subroutine generatebasin(igridmethod) ! do itime=1,3 !Refine one time in general is sufficient write(*,*) "Detecting boundary grids..." call detectinterbasgrd(6) !It seems that using 26 directions to determine boundary grids doesn't bring evident benefit - write(*,"(' There are',i12,' grids at basin boundary')") count(interbasgrid==.true.) + write(*,"(' There are',i12,' grids at basin boundary')") count(interbasgrid) write(*,*) "Refining basin boundary..." !Below code is the adapted copy of above near-grid code !$OMP PARALLEL DO private(ix,iy,iz,corrx,corry,corrz,ntrjgrid,inowx,inowy,inowz,valnow,imove,gradtmp,igradmax,gradmax,iatt,& @@ -940,7 +940,7 @@ subroutine generatebasin(igridmethod) do iz=2,nz-1 do iy=2,ny-1 do ix=2,nx-1 - if (interbasgrid(ix,iy,iz)==.false.) cycle + if (.not.interbasgrid(ix,iy,iz)) cycle if (gridbas(ix,iy,iz)<=0) cycle !Ignored the ones unassigned or gone to box boundary ntrjgrid=0 inowx=ix @@ -2067,7 +2067,7 @@ subroutine atmpopinbasin use basinintmod implicit real*8(a-h,o-z) inquire(file="basin.cub",exist=alive) -if (alive==.false.) then +if (.not.alive) then write(*,*) "Error: basin.cub is not existed in current folder!" return else @@ -3329,7 +3329,7 @@ subroutine integratebasinmix(itype) rnowy=yarr(iy) do ix=2,nx-1 rnowx=xarr(ix) - if ((itype==2.or.itype==3).and.interbasgrid(ix,iy,iz)==.true.) cycle !If refine boundary grid at next stage, we don't calculate them at present stage + if ((itype==2.or.itype==3).and.interbasgrid(ix,iy,iz)) cycle !If refine boundary grid at next stage, we don't calculate them at present stage ! if (iz==nint(nz/2D0)) write(1,"('C',3f14.8)") rnowx*b2a,rnowy*b2a,rnowz*b2a !Examine grid distribution iatt=gridbas(ix,iy,iz) ! do icp=1,numcp @@ -3437,7 +3437,7 @@ subroutine integratebasinmix(itype) rnowy=yarr(iy) do ix=2,nx-1 rnowx=xarr(ix) - if (interbasgrid(ix,iy,iz)==.false.) cycle + if (.not.interbasgrid(ix,iy,iz)) cycle ! if (cubmat(ix,iy,iz)>0.001D0) then ! nrefine=2 !3 is the best ! else if (cubmat(ix,iy,iz)>0.001D0) then !0.0001 is the best @@ -3597,7 +3597,7 @@ subroutine integratebasinmix(itype) !$OMP END PARALLEL call detectinterbasgrd(6) write(*,*) "Basin boundary has been updated" - numinterbas=count(interbasgrid==.true.) + numinterbas=count(interbasgrid) write(*,"(' The number of interbasin grids:',i12)") numinterbas end if diff --git a/src/define.f90 b/src/define.f90 index 56f860c..abf71a9 100644 --- a/src/define.f90 +++ b/src/define.f90 @@ -19,6 +19,7 @@ module deftype !============ Store globally shared information module defvar use deftype +private i real*8,parameter :: pi=3.141592653589793D0,b2a=0.529177249D0 !1 Bohr = 0.529177249 Angstrom real*8,parameter :: au2kcal=627.51D0,au2KJ=2625.5D0,au2eV=27.2113838D0,cal2J=4.184D0 real*8,parameter :: masse=9.10938215D-31,chge=1.602176487D0,lightc=2.99792458D8,au2debye=2.5417462D0 !masse/chge: Mass/charge of an electron @@ -52,7 +53,7 @@ module defvar integer :: if_initlibreta=0 !If LIBRETA has been initialized for present wavefunction by running "call initlibreta" integer,parameter :: ncolormax=16,ngoodcolor=15 -character*10 :: colorname(ncolormax)=(/"Red","Green","Blue","White","Black","Gray","Cyan","Yellow","Orange","Magenta","Crimson","Dark green","Purple","Brown","Dark blue","Pink"/) !Color name involved setcolor/selcolor routine +character*10 :: colorname(ncolormax)=(/"Red ","Green ","Blue ","White ","Black ","Gray ","Cyan ","Yellow ","Orange ","Magenta ","Crimson ","Dark green","Purple ","Brown ","Dark blue ","Pink "/) !Color name involved setcolor/selcolor routine integer :: goodcolor(ngoodcolor)=(/5,1,3,12,9,10,14,13,11,15,16,2,7,8,6/) !Color list suitable for plotting lines, good colors appear prior to bad ones. Black,Red,Blue,Dark green,Orange,Magenta,Brown,Purple,Crimson,Dark blue,Pink,Green,Cyan,Yellow,Gray !The name for superheavy atoms are consistent with Stuttgart PP website: http://www.tc.uni-koeln.de/PP/clickpse.en.html character*2 :: ind2name(0:nelesupp)=(/ "Bq","H ","He", & !Bq(number 0) is ghost atom. Bq is recorded in .fch, but X is not recorded @@ -244,7 +245,7 @@ module defvar type(primtype),allocatable :: b(:),b_org(:),b_tmp(:) real*8,allocatable :: MOocc(:),MOocc_org(:),MOene(:),MOene_org(:) !Occupation number & energy of orbital integer,allocatable :: MOtype(:) !The type of orbitals, (alpha&beta)=0/alpha=1/beta=2, not read from .wfn directly -character*10 :: orbtypename(0:2)=(/ "Alpha&Beta","Alpha","Beta" /) +character*10 :: orbtypename(0:2)=(/ "Alpha&Beta","Alpha ","Beta " /) character*4,allocatable :: MOsym(:) !The symmetry of orbitals, meaningful when .mwfn/molden/gms is used real*8,allocatable :: CO(:,:),CO_org(:,:),CO_tmp(:,:) !Coefficient matrix of primitive basis functions, including both normalization and contraction coefficients !Note: Row/column of CO denote MO/GTF respectively, in contrary to convention @@ -325,7 +326,7 @@ module defvar integer GUI_mode !Plotting external parameter, can be set in settings.ini -character :: graphformat*4="png ",graphformatname(9)=(/"png","gif","tiff","bmp","ps","eps","pdf","wmf","svg"/) +character :: graphformat*4="png ",graphformatname(9)=(/"png ","gif ","tiff","bmp ","ps ","eps ","pdf ","wmf ","svg "/) integer :: graph1Dwidth=1280,graph1Dheight=800,graph2Dwidth=1280,graph2Dheight=1200,graph3Dwidth=1400,graph3Dheight=1400 integer :: itickreverse=0,iticks=2,symbolsize=8,ilenunit1D=1,ilenunit2D=1,iatmlabtype=1,iatmlabtype3D=3,iplaneextdata=0,itransparent=0 integer :: numdigx=2,numdigy=2,numdigz=3,numdiglinex=3,numdigliney=3,numdigctr=3 @@ -350,8 +351,25 @@ module defvar integer :: inucespplot=0,idrawmol=1,idrawisosur=0,isosursec=0,idrawtype=1,idrawcontour=1 integer :: iinvgradvec=0,icolorvecfield=0,vecclrind=30,idrawplanevdwctr=0,iplaneoutall=0,icurvethick=5,iclrtrans=0 integer,allocatable :: highlightatomlist(:) -character :: stream_intmethod*5="RK2",clrtransname(0:18)*50=(/ "Rainbow & white/black for out-of-limit data","Rainbow","Reversed rainbow","Rainbow starting from white","Spectrum","Reversed Spectrum","Grey","Reversed Grey","Blue-White-Red",& -"Red-White-Blue","Blue-Green-Red","Red-Green-Blue","White-Dark red","Black-Orange-Yellow","White-Dark green","Black-Green","White-Dark blue","Black-Blue-Cyan","Viridis" /) +character :: stream_intmethod*5="RK2",clrtransname(0:18)*50=(/ "Rainbow & white/black for out-of-limit data",& + "Rainbow ",& + "Reversed rainbow ",& + "Rainbow starting from white ",& + "Spectrum ",& + "Reversed Spectrum ",& + "Grey ",& + "Reversed Grey ",& + "Blue-White-Red ",& + "Red-White-Blue ",& + "Blue-Green-Red ",& + "Red-Green-Blue ",& + "White-Dark red ",& + "Black-Orange-Yellow ",& + "White-Dark green ",& + "Black-Green ",& + "White-Dark blue ",& + "Black-Blue-Cyan ",& + "Viridis " /) real*8 :: surcolorzmin,surcolorzmax !fillctr is the contour value will be draw on fillcolor map real*8 :: curve_vertlinex=0D0,curvexyratio=0.618D0 !Gold partition real*8 :: gradplotstep=0.002D0,gradplotdis=0.01D0,gradplottest=0.2D0,cutgradvec=0.3D0 diff --git a/src/excittrans.f90 b/src/excittrans.f90 index 5c4a2b6..49d0187 100644 --- a/src/excittrans.f90 +++ b/src/excittrans.f90 @@ -1129,7 +1129,7 @@ subroutine hole_electron implicit real*8 (a-h,o-z) integer :: idomag=0 real*8 orbval(nmo),wfnderv(3,nmo) -integer,allocatable :: skippair(:) !Record which orbital pairs will be ignored due to negligible coefficient +logical,allocatable :: skippair(:) !Record which orbital pairs will be ignored due to negligible coefficient real*8,allocatable :: holegrid(:,:,:),elegrid(:,:,:),Sm(:,:,:),Sr(:,:,:),transdens(:,:,:),holecross(:,:,:),elecross(:,:,:),Cele(:,:,:),Chole(:,:,:),magtrdens(:,:,:,:) real*8,allocatable :: cubx(:),cuby(:),cubz(:) !Used to calculate Coulomb attractive energy character cubsuff*12 @@ -1257,14 +1257,14 @@ subroutine hole_electron ! Currently only take below cases into account: ! Cross term of hole (do ): i->l,j->l substract i<-l,j<-l ! Cross term of electron (do ): i->l,i->m substract i<-l,i<-m - if (skippair(iexcitorb)==.true.) cycle + if (skippair(iexcitorb)) cycle ileft=orbleft(iexcitorb) iright=orbright(iexcitorb) tmpleft=exccoeff(iexcitorb)*orbval(ileft) !Use temporary variable to save the time for locating element tmpright=exccoeff(iexcitorb)*orbval(iright) idir=excdir(iexcitorb) do jexcitorb=1,excnorb - if (skippair(jexcitorb)==.true.) cycle + if (skippair(jexcitorb)) cycle jleft=orbleft(jexcitorb) jright=orbright(jexcitorb) jdir=excdir(jexcitorb) @@ -4282,7 +4282,7 @@ is different (spin-forbidden), the transition dipole moment analyzed in this fun imo=orbleft(iexcitorb) jmo=orbright(iexcitorb) strdir=" ->" - if (excdir(iexcitorb)==2) strtmp1=" <-" + if (excdir(iexcitorb)==2) strdir=" <-" if (wfntype==0.or.wfntype==3) then write(10,"(i8,i7,a,i7,f12.6,3x,3f11.6)") iexcitorb,imo,strdir,jmo,exccoeff(iexcitorb),dipcontri(:,iexcitorb) else diff --git a/src/fileIO.f90 b/src/fileIO.f90 index 8752797..0fb49dd 100644 --- a/src/fileIO.f90 +++ b/src/fileIO.f90 @@ -58,7 +58,7 @@ subroutine readinfile(thisfilename,infomode) stop end if inquire(file=formchkpath,exist=alive) - if (alive==.false.) then + if (.not.alive) 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" @@ -97,7 +97,7 @@ subroutine readinfile(thisfilename,infomode) stop end if inquire(file=orca_2mklpath,exist=alive) - if (alive==.false.) then + if (.not.alive) 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" @@ -2806,7 +2806,9 @@ subroutine readwfx(name,infomode) read(10,*) a%charge call loclabel(10,"") read(10,*) -read(10,*) ((a(i)%x,a(i)%y,a(i)%z),i=1,ncenter) +do i=1,ncenter + read(10,*) a(i)%x,a(i)%y,a(i)%z +enddo call loclabel(10,"") read(10,*) read(10,*) nelec @@ -6978,9 +6980,9 @@ subroutine loadsetting if (ifound==0) then inquire(file="settings.ini",exist=alive) - if (alive==.true.) then + if (alive) then settingpath="settings.ini" - else if (alive==.false.) then + else if (.not.alive) then call getenv("Multiwfnpath",c80tmp) if (isys==1) then settingpath=trim(c80tmp)//"\settings.ini" @@ -6988,7 +6990,7 @@ subroutine loadsetting settingpath=trim(c80tmp)//"/settings.ini" end if inquire(file=settingpath,exist=alive) - if (alive==.false.) then + if (.not.alive) 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(*,*) diff --git a/src/function.f90 b/src/function.f90 index 4a6a6ad..b751769 100644 --- a/src/function.f90 +++ b/src/function.f90 @@ -2404,7 +2404,7 @@ subroutine planeesp alive=.false. if (cubegenpath/=" ".and.ifiletype==1) then inquire(file=cubegenpath,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(a)") " Note: Albeit current file type is fch/fchk/chk and ""cubegenpath"" parameter in settings.ini has been defined, & the cubegen cannot be found, therefore electrostatic potential will still be calculated using internal code of Multiwfn" end if diff --git a/src/otherfunc.f90 b/src/otherfunc.f90 index 6929f31..3f4891f 100644 --- a/src/otherfunc.f90 +++ b/src/otherfunc.f90 @@ -4218,7 +4218,7 @@ subroutine CDFT inquire(file="N+1.wfn",exist=alivewfn(2)) inquire(file="N-1.wfn",exist=alivewfn(3)) if (iwcubic==1) inquire(file="N-2.wfn",exist=alivewfn(4)) - if (any(alivewfn==.false.)) then + if (any(.not.alivewfn)) then if (iwcubic==0) write(*,"(a)") " Error: To use this function, N.wfn, N+1.wfn and N-1.wfn must all be presented in current folder!" if (iwcubic==1) write(*,"(a)") " Error: To use this function, N.wfn, N+1.wfn, N-1.wfn and N-2.wfn must all be presented in current folder!" write(*,*) "Press ENTER button to cancel current analysis" diff --git a/src/otherfunc2.f90 b/src/otherfunc2.f90 index 22884a3..fba2570 100644 --- a/src/otherfunc2.f90 +++ b/src/otherfunc2.f90 @@ -3836,7 +3836,7 @@ subroutine domainana open(10,file="domain.pdb",status="replace") do igrd=1,domainsize(idomain) idx=domaingrid(idomain,igrd) - if (boundgrid(idx)==.true.) then + if (boundgrid(idx)) then xnow=gridxyz(idx,1) ynow=gridxyz(idx,2) znow=gridxyz(idx,3) diff --git a/src/plot.f90 b/src/plot.f90 index afe6198..2fe6d3a 100644 --- a/src/plot.f90 +++ b/src/plot.f90 @@ -254,13 +254,13 @@ subroutine drawmol tmpy=orgy+(iy-1)*dy tmpz=orgz+(iz-1)*dz if (ishowbasinmethod==1) then !Entire basin - if (interbasgrid(ix,iy,iz)==.true.) CALL SPHE3D(tmpx,tmpy,tmpz,basinsphsize,4,4) !Show sphere of interbasin grids + if (interbasgrid(ix,iy,iz).eqv..true.) CALL SPHE3D(tmpx,tmpy,tmpz,basinsphsize,4,4) !Show sphere of interbasin grids if (idrawinternalbasin==1) then !Draw quad at box boundary to shield internal region of basin if (ix==2.or.ix==nx-1.or.iy==2.or.iy==ny-1.or.iz==2.or.iz==nz-1) CALL QUAD3D(tmpx,tmpy,tmpz,dx,dy,dz) end if else if (ishowbasinmethod==2) then !Basin within vdW surface if (rhocub(ix,iy,iz)<0.001D0) cycle - if (interbasgrid(ix,iy,iz)==.true.) then !Interbasin grid + if (interbasgrid(ix,iy,iz).eqv..true.) then !Interbasin grid CALL SPHE3D(tmpx,tmpy,tmpz,basinsphsize,4,4) else !Internal grid in the basin if (idrawinternalbasin==1) CALL SPHE3D(tmpx,tmpy,tmpz,basinsphsize,4,4) diff --git a/src/population.f90 b/src/population.f90 index 894abbd..abfd9fb 100644 --- a/src/population.f90 +++ b/src/population.f90 @@ -715,6 +715,7 @@ subroutine spacecharge(chgtype) type(content) gridatm(radpot*sphpot),gridatmorg(radpot*sphpot) real*8 atmdipx(ncenter),atmdipy(ncenter),atmdipz(ncenter),charge(ncenter) real*8 :: covr_becke(0:nelesupp) !covalent radii used for Becke population +character(200) :: radfilename integer :: nbeckeiter=3 if (chgtype==5) then !Select atomic radii for Becke population @@ -1634,7 +1635,7 @@ subroutine RESP write(*,*) "The current additional fitting centers have been cleaned" else inquire(file=addcenfilepath,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Error: Cannot find the file! Press ENTER button to cancel" read(*,*) cycle @@ -3119,7 +3120,7 @@ subroutine fitESP_calcESP(ishowprompt,iESPtype,nESPpt,ESPpt,ESPptval,calcfilepat alive=.false. if (cubegenpath/=" ".and.ifiletype==1) then inquire(file=cubegenpath,exist=alive) - if (alive==.false..and.ishowprompt==1) then + if (.not.alive.and.ishowprompt==1) then write(*,"(a)") " Note: Albeit current file type is fch/fchk/chk and ""cubegenpath"" parameter in settings.ini has been defined, & the cubegen cannot be found, therefore electrostatic potential will still be calculated using internal code of Multiwfn" end if @@ -3409,7 +3410,7 @@ subroutine Hirshfeld_I(itype) if (a(jatm)%index==1.and.istat==1) cycle !H+ doesn't contains electron and cannot compute density c80tmp="atmrad"//sep//trim(a(jatm)%name)//statname(istat)//".rad" inquire(file=c80tmp,exist=alive) - if (alive==.false.) cycle + if (.not.alive) cycle open(10,file=c80tmp,status="old") read(10,*) atmradnpt(jatm) do ipt=1,atmradnpt(jatm) @@ -3522,7 +3523,7 @@ subroutine Hirshfeld_I(itype) radrholow=0 c80tmp="atmrad"//sep//trim(a(iatm)%name)//statname(ichglow)//".rad" inquire(file=c80tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(' Error: ',a,' is needed but was not prepared!')") trim(c80tmp) write(*,"(' Current charge of atom',i5,'(',a,'):',f12.8)") iatm,a(iatm)%name,charge(iatm) write(*,"(a)") " Note: This error implies that this atom has unusual charge. You should manually provide the corresponding .rad file & @@ -3540,7 +3541,7 @@ subroutine Hirshfeld_I(itype) radrhohigh=0 c80tmp="atmrad"//sep//trim(a(iatm)%name)//statname(ichghigh)//".rad" inquire(file=c80tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(' Error: ',a,' is needed but was not prepared!')") trim(c80tmp) write(*,"(' Current charge of atom',i5,'(',a,'):',f12.8)") iatm,a(iatm)%name,charge(iatm) write(*,"(a)") " Note: This error implies that this atom has unusual charge. You should manually provide the corresponding .rad file & @@ -3778,8 +3779,8 @@ subroutine genatmradfile end if !Generate .gjf file - inquire(directory="atmrad",exist=alive) - if (alive==.false.) call system("mkdir atmrad") + inquire(file="atmrad",exist=alive) + if (.not.alive) call system("mkdir atmrad") c200tmp="atmrad"//sep//trim(a(iatm)%name)//statname(istat)//".gjf" open(10,file=c200tmp,status="replace") write(10,"(a)") "# "//trim(calclevel)//" out=wfn" @@ -3838,7 +3839,7 @@ subroutine genatmradfile inquire(file=trim(c80tmp)//".rad",exist=alive) if (alive) cycle inquire(file=trim(c80tmp)//".wfn",exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(' Error: ',a,' was not found!')") trim(c80tmp)//".wfn" write(*,*) "If you want to skip, press ENTER button directly" read(*,*) diff --git a/src/spectrum.f90 b/src/spectrum.f90 index b35f7bf..11e3271 100644 --- a/src/spectrum.f90 +++ b/src/spectrum.f90 @@ -123,7 +123,7 @@ subroutine plotspectrum nsystem=nsystem+1 inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(' Error: Cannot find ',a)") trim(c200tmp) if (index(c200tmp,'/')/=0) then write(*,*) "Reminder: Since the file path contains / symbol, you should add "" at the two ends of the path, so that the file can be properly loaded" @@ -362,7 +362,7 @@ subroutine plotspectrum read(*,"(a)") c200tmp if (c200tmp==" ") c200tmp="spectrum.dat" inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Error: Cannot find the file! Press ENTER button to return" read(*,*) cycle @@ -2335,7 +2335,7 @@ subroutine NMRplot if (mollegend(i)(1:1)=='$') mollegend(i)=mollegend(i)(2:) end if inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(' Error: Cannot find ',a)") trim(c200tmp) if (index(c200tmp,'/')/=0) then write(*,*) "Reminder: Since the file path contains / symbol, you should add "" at the two ends of the path, so that the file can be properly loaded" @@ -2533,7 +2533,7 @@ subroutine NMRplot read(*,"(a)") c200tmp if (c200tmp==" ") c200tmp="NMR.dat" inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Error: Cannot find the file! Press ENTER button to return" read(*,*) cycle diff --git a/src/sub.f90 b/src/sub.f90 index 37da193..6f87c08 100644 --- a/src/sub.f90 +++ b/src/sub.f90 @@ -7,7 +7,7 @@ subroutine modwfn real*8 eigval(nbasis),eigvec(nbasis,nbasis),tmpmat(nbasis,nbasis) integer orbarr(nmo) integer,allocatable :: exclfragatm(:),tmparrint(:) -character*3 :: orbtype(0:2)=(/ "A+B"," A"," B" /) +character*3 :: orbtype(0:2)=(/ "A+B"," A "," B " /) character*6 :: symstr do while(.true.) @@ -1193,7 +1193,7 @@ subroutine savecubmat(functype,infomode,iorb) alive=.false. if (cubegenpath/=" ".and.ifiletype==1.and.functype==12) then inquire(file=cubegenpath,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(a)") " Note: Albeit current file type is fch/fchk/chk and ""cubegenpath"" parameter in settings.ini has been defined, & the cubegen cannot be found, therefore electrostatic potential will still be calculated using internal code of Multiwfn" end if @@ -1419,30 +1419,30 @@ subroutine setpromol if (isys==1) tmpdir="wfntmp\" if (isys==2) tmpdir="wfntmp/" c80tmp="wfntmp" - inquire(directory="wfntmp",exist=alivewfntmp) - if (isys==1.and.alivewfntmp==.true.) then !delete old wfntmp folder + inquire(file="wfntmp",exist=alivewfntmp) + if (isys==1.and.alivewfntmp) then !delete old wfntmp folder write(*,*) "Running: rmdir /S /Q wfntmp" call system("rmdir /S /Q wfntmp") - else if (isys==2.and.alivewfntmp==.true.) then + else if (isys==2.and.alivewfntmp) then write(*,*) "Running: rm -rf wfntmp" call system("rm -rf wfntmp") end if else if (iwfntmptype==2) then do i=1,9999 !Find a proper name of temporary folder write(c80tmp,"('wfntmp',i4.4)") i - inquire(directory=c80tmp,exist=alivewfntmp) - if (alivewfntmp==.false.) exit + inquire(file=c80tmp,exist=alivewfntmp) + if (.not.alivewfntmp) exit end do if (isys==1) write(tmpdir,"('wfntmp',i4.4,'\')") i if (isys==2) write(tmpdir,"('wfntmp',i4.4,'/')") i end if write(*,*) "Running: mkdir "//trim(c80tmp) !Build new temporary folder call system("mkdir "//trim(c80tmp)) -inquire(directory="atomwfn",exist=aliveatomwfn) -if (isys==1.and.aliveatomwfn==.true.) then +inquire(file="atomwfn",exist=aliveatomwfn) +if (isys==1.and.aliveatomwfn) then write(*,*) "Running: copy atomwfn\*.wfn "//trim(tmpdir) call system("copy atomwfn\*.wfn "//trim(tmpdir)) -else if (isys==2.and.aliveatomwfn==.true.) then +else if (isys==2.and.aliveatomwfn) then write(*,*) "Running: cp atomwfn/*.wfn "//trim(tmpdir) call system("cp atomwfn/*.wfn "//trim(tmpdir)) end if @@ -3180,7 +3180,7 @@ subroutine loadFock47(istatus) write(*,*) "Note: If the suffix is .47, the Fock matrix will be directly loaded from it" read(*,"(a)") c200tmp inquire(file=c200tmp,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,*) "Error: Unable to find this file! Input again" cycle end if diff --git a/src/surfana.f90 b/src/surfana.f90 index 5879c2c..c56a75e 100644 --- a/src/surfana.f90 +++ b/src/surfana.f90 @@ -571,7 +571,7 @@ subroutine surfana do ix=1,numcubx do iy=1,numcuby do iz=1,numcubz - if (ifbndcub(ix,iy,iz)==.true.) then !Numbering of cube corner is identical to figure 3 of WFA original paper + if (ifbndcub(ix,iy,iz)) then !Numbering of cube corner is identical to figure 3 of WFA original paper call marchtetra(ix,iy,iz) ! call marchcube(ix,iy,iz) end if @@ -824,7 +824,7 @@ subroutine surfana alive=.false. if (cubegenpath/=" ".and.ifiletype==1.and.imapfunc==1) then inquire(file=cubegenpath,exist=alive) - if (alive==.false.) then + if (.not.alive) then write(*,"(a)") " Note: Albeit current file type is fch/fchk/chk and ""cubegenpath"" parameter in settings.ini has been defined, & the cubegen cannot be found, therefore electrostatic potential will still be calculated using internal code of Multiwfn" end if diff --git a/src/util.f90 b/src/util.f90 index a5f8d2f..c2f3bcd 100644 --- a/src/util.f90 +++ b/src/util.f90 @@ -1852,7 +1852,7 @@ subroutine showprog(inow,nall) c80tmp(79:79)='/' itmp=0 end if -write(*,"(2a\)") trim(c80tmp),char(13) +write(*,"(2a$)") trim(c80tmp),char(13) if (inow>=nall) write(*,*) end subroutine