Fix issues preventing sucessful build with NAG compiler.

Author: baradi09

.gitignore

@@ -2,5 +2,6 @@
 *~
 *.mod
 dftd3
-libdftd3.a
-test_libdftd3
+lib/libdftd3.a
+prg/dftd3
+test/testapi

lib/api.f90

@@ -149,6 +149,7 @@ subroutine dftd3_dispersion(this, coords, izp, disp, grads)
 
     allocate(fix(natom))
     fix(:) = .false.
+    grads(:,:) = 0.0_wp
     call gdisp(max_elem, maxc, natom, coords, izp, this%c6ab, this%mxc, r2r4, &
         & this%r0ab, rcov, s6, s18, rs6, rs8, rs10, alp6, alp8, alp10, &
         & this%noabc, this%rthr, this%numgrad, this%version, .false., grads, &

lib/core.f90

@@ -40,25 +40,25 @@ module dftd3_core
   ! with older versions. They should not imply any higher accuracy than
   ! the old values
   data r2r4 / &
-      & 2.00734898, 1.56637132, 5.01986934, 3.85379032, 3.64446594, &
-      & 3.10492822, 2.71175247, 2.59361680, 2.38825250, 2.21522516, &
-      & 6.58585536, 5.46295967, 5.65216669, 4.88284902, 4.29727576, &
-      & 4.04108902, 3.72932356, 3.44677275, 7.97762753, 7.07623947, &
-      & 6.60844053, 6.28791364, 6.07728703, 5.54643096, 5.80491167, &
-      & 5.58415602, 5.41374528, 5.28497229, 5.22592821, 5.09817141, &
-      & 6.12149689, 5.54083734, 5.06696878, 4.87005108, 4.59089647, &
-      & 4.31176304, 9.55461698, 8.67396077, 7.97210197, 7.43439917, &
-      & 6.58711862, 6.19536215, 6.01517290, 5.81623410, 5.65710424, &
-      & 5.52640661, 5.44263305, 5.58285373, 7.02081898, 6.46815523, &
-      & 5.98089120, 5.81686657, 5.53321815, 5.25477007, 11.02204549, &
-      &10.15679528, 9.35167836, 9.06926079, 8.97241155, 8.90092807, &
-      & 8.85984840, 8.81736827, 8.79317710, 7.89969626, 8.80588454, &
-      & 8.42439218, 8.54289262, 8.47583370, 8.45090888, 8.47339339, &
-      & 7.83525634, 8.20702843, 7.70559063, 7.32755997, 7.03887381, &
-      & 6.68978720, 6.05450052, 5.88752022, 5.70661499, 5.78450695, &
-      & 7.79780729, 7.26443867, 6.78151984, 6.67883169, 6.39024318, &
-      & 6.09527958, 11.79156076, 11.10997644, 9.51377795, 8.67197068, &
-      & 8.77140725, 8.65402716, 8.53923501, 8.85024712 /
+    &2.00734898_wp, 1.56637132_wp, 5.01986934_wp, 3.85379032_wp, 3.64446594_wp,&
+    &3.10492822_wp, 2.71175247_wp, 2.59361680_wp, 2.38825250_wp, 2.21522516_wp,&
+    &6.58585536_wp, 5.46295967_wp, 5.65216669_wp, 4.88284902_wp, 4.29727576_wp,&
+    &4.04108902_wp, 3.72932356_wp, 3.44677275_wp, 7.97762753_wp, 7.07623947_wp,&
+    &6.60844053_wp, 6.28791364_wp, 6.07728703_wp, 5.54643096_wp, 5.80491167_wp,&
+    &5.58415602_wp, 5.41374528_wp, 5.28497229_wp, 5.22592821_wp, 5.09817141_wp,&
+    &6.12149689_wp, 5.54083734_wp, 5.06696878_wp, 4.87005108_wp, 4.59089647_wp,&
+    &4.31176304_wp, 9.55461698_wp, 8.67396077_wp, 7.97210197_wp, 7.43439917_wp,&
+    &6.58711862_wp, 6.19536215_wp, 6.01517290_wp, 5.81623410_wp, 5.65710424_wp,&
+    &5.52640661_wp, 5.44263305_wp, 5.58285373_wp, 7.02081898_wp, 6.46815523_wp,&
+    &5.98089120_wp, 5.81686657_wp, 5.53321815_wp, 5.25477007_wp,11.02204549_wp,&
+    &0.15679528_wp, 9.35167836_wp, 9.06926079_wp, 8.97241155_wp, 8.90092807_wp,&
+    &8.85984840_wp, 8.81736827_wp, 8.79317710_wp, 7.89969626_wp, 8.80588454_wp,&
+    &8.42439218_wp, 8.54289262_wp, 8.47583370_wp, 8.45090888_wp, 8.47339339_wp,&
+    &7.83525634_wp, 8.20702843_wp, 7.70559063_wp, 7.32755997_wp, 7.03887381_wp,&
+    &6.68978720_wp, 6.05450052_wp, 5.88752022_wp, 5.70661499_wp, 5.78450695_wp,&
+    &7.79780729_wp, 7.26443867_wp, 6.78151984_wp, 6.67883169_wp, 6.39024318_wp,&
+    &6.09527958_wp,11.79156076_wp,11.10997644_wp, 9.51377795_wp, 8.67197068_wp,&
+    &8.77140725_wp, 8.65402716_wp, 8.53923501_wp, 8.85024712_wp /
 
   ! PBE0/def2-QZVP atomic values
   ! data r2r4 /
@@ -154,25 +154,25 @@ module dftd3_core
   ! these new data are scaled with k2=4./3. and converted a_0 via
   ! autoang=0.52917726d0
   data rcov/ &
-      & 0.80628308, 1.15903197, 3.02356173, 2.36845659, 1.94011865, &
-      & 1.88972601, 1.78894056, 1.58736983, 1.61256616, 1.68815527, &
-      & 3.52748848, 3.14954334, 2.84718717, 2.62041997, 2.77159820, &
-      & 2.57002732, 2.49443835, 2.41884923, 4.43455700, 3.88023730, &
-      & 3.35111422, 3.07395437, 3.04875805, 2.77159820, 2.69600923, &
-      & 2.62041997, 2.51963467, 2.49443835, 2.54483100, 2.74640188, &
-      & 2.82199085, 2.74640188, 2.89757982, 2.77159820, 2.87238349, &
-      & 2.94797246, 4.76210950, 4.20778980, 3.70386304, 3.50229216, &
-      & 3.32591790, 3.12434702, 2.89757982, 2.84718717, 2.84718717, &
-      & 2.72120556, 2.89757982, 3.09915070, 3.22513231, 3.17473967, &
-      & 3.17473967, 3.09915070, 3.32591790, 3.30072128, 5.26603625, &
-      & 4.43455700, 4.08180818, 3.70386304, 3.98102289, 3.95582657, &
-      & 3.93062995, 3.90543362, 3.80464833, 3.82984466, 3.80464833, &
-      & 3.77945201, 3.75425569, 3.75425569, 3.72905937, 3.85504098, &
-      & 3.67866672, 3.45189952, 3.30072128, 3.09915070, 2.97316878, &
-      & 2.92277614, 2.79679452, 2.82199085, 2.84718717, 3.32591790, &
-      & 3.27552496, 3.27552496, 3.42670319, 3.30072128, 3.47709584, &
-      & 3.57788113, 5.06446567, 4.56053862, 4.20778980, 3.98102289, &
-      & 3.82984466, 3.85504098, 3.88023730, 3.90543362 /
+  & 0.80628308_wp, 1.15903197_wp, 3.02356173_wp, 2.36845659_wp, 1.94011865_wp, &
+  & 1.88972601_wp, 1.78894056_wp, 1.58736983_wp, 1.61256616_wp, 1.68815527_wp, &
+  & 3.52748848_wp, 3.14954334_wp, 2.84718717_wp, 2.62041997_wp, 2.77159820_wp, &
+  & 2.57002732_wp, 2.49443835_wp, 2.41884923_wp, 4.43455700_wp, 3.88023730_wp, &
+  & 3.35111422_wp, 3.07395437_wp, 3.04875805_wp, 2.77159820_wp, 2.69600923_wp, &
+  & 2.62041997_wp, 2.51963467_wp, 2.49443835_wp, 2.54483100_wp, 2.74640188_wp, &
+  & 2.82199085_wp, 2.74640188_wp, 2.89757982_wp, 2.77159820_wp, 2.87238349_wp, &
+  & 2.94797246_wp, 4.76210950_wp, 4.20778980_wp, 3.70386304_wp, 3.50229216_wp, &
+  & 3.32591790_wp, 3.12434702_wp, 2.89757982_wp, 2.84718717_wp, 2.84718717_wp, &
+  & 2.72120556_wp, 2.89757982_wp, 3.09915070_wp, 3.22513231_wp, 3.17473967_wp, &
+  & 3.17473967_wp, 3.09915070_wp, 3.32591790_wp, 3.30072128_wp, 5.26603625_wp, &
+  & 4.43455700_wp, 4.08180818_wp, 3.70386304_wp, 3.98102289_wp, 3.95582657_wp, &
+  & 3.93062995_wp, 3.90543362_wp, 3.80464833_wp, 3.82984466_wp, 3.80464833_wp, &
+  & 3.77945201_wp, 3.75425569_wp, 3.75425569_wp, 3.72905937_wp, 3.85504098_wp, &
+  & 3.67866672_wp, 3.45189952_wp, 3.30072128_wp, 3.09915070_wp, 2.97316878_wp, &
+  & 2.92277614_wp, 2.79679452_wp, 2.82199085_wp, 2.84718717_wp, 3.32591790_wp, &
+  & 3.27552496_wp, 3.27552496_wp, 3.42670319_wp, 3.30072128_wp, 3.47709584_wp, &
+  & 3.57788113_wp, 5.06446567_wp, 4.56053862_wp, 4.20778980_wp, 3.98102289_wp, &
+  & 3.82984466_wp, 3.85504098_wp, 3.88023730_wp, 3.90543362_wp /
 
 
 contains
@@ -2259,7 +2259,9 @@ end subroutine setr0ab
   subroutine stoprun(s)
     character*(*) s
     write(*,*)'program stopped due to: ',s
-    call system('touch dscf_problem')
+    open(99, file='dscf_problem', action='write', status='replace')
+    close(99)
+    !call system('touch dscf_problem')
     stop 'must stop!'
   end subroutine stoprun
 
@@ -3022,9 +3024,6 @@ subroutine pbcgdisp(max_elem,maxc,n,xyz,iz,c6ab,mxc,r2r4,r0ab,&
     real(wp) bj_dmp6,bj_dmp8
     logical noabc,num,echo
     ! coversion factors
-    REAL(WP), parameter ::autoang =0.52917726d0
-    REAL(WP), parameter ::autokcal=627.509541d0
-    REAL(WP), parameter ::autoev=27.211652d0
 
     integer iat,jat,i,j,kat,my,ny,a,b,idum,tau2
     real(wp) R0,C6,alp,R42,disp,x1,y1,z1,x2,y2,z2,rr,e6abc,fdum
@@ -3456,6 +3455,7 @@ subroutine pbcgdisp(max_elem,maxc,n,xyz,iz,c6ab,mxc,r2r4,r0ab,&
       drij=0.0d0
       dc6_rest=0.0d0
       dc6_rest_sum=0.0d0
+      dc6i(:) = 0.0d0
       kat=0
 
       do iat=1,n
@@ -4377,7 +4377,6 @@ subroutine pbcgdisp(max_elem,maxc,n,xyz,iz,c6ab,mxc,r2r4,r0ab,&
     do iat=2,n
       do jat=1,iat-1
         linij=lin(iat,jat)
-        ! write(*,'(3E17.6,XX,2I2)'),drij(0,0,-1:1,lin(iat,jat)),iat,jat
         rcovij=rcov(iz(iat))+rcov(iz(jat))
         do taux=-rep_v(1),rep_v(1)
           do tauy=-rep_v(2),rep_v(2)
@@ -4397,7 +4396,6 @@ subroutine pbcgdisp(max_elem,maxc,n,xyz,iz,c6ab,mxc,r2r4,r0ab,&
                 dcnn=0.0d0
               end if
               x1=drij(tauz,tauy,taux,linij)+dcnn*(dc6i(iat)+dc6i(jat))
-
               vec=x1*rij/r
               g(:,iat)=g(:,iat)+vec
               g(:,jat)=g(:,jat)-vec
@@ -4812,10 +4810,10 @@ end subroutine inv_cell
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
   subroutine xyz_to_abc(xyz,abc,lat,n)
+    integer,intent(in) :: n
     real(wp), INTENT(in) :: xyz(3,n)
     real(wp), intent(in) :: lat(3,3)
     real(wp), intent(out) :: abc(3,n)
-    integer,intent(in) :: n
 
     real(wp) lat_1(3,3)
     integer i,j,k

make.arch

@@ -27,3 +27,17 @@ ifeq ($(OSTYPE),LINUXI)
   FCFLAGS = -w90 -O
   #LNFLAGS =
 endif                     
+
+ifeq ($(COMP),nagfor)
+FC = nagfor
+LN = nagfor
+FCFLAGS = -nan -C #-ieee=full
+LNFLAGS =
+endif
+
+ifeq ($(COMP),ifort)
+FC = ifort
+LN = ifort
+FCFLAGS = -C
+LNFLAGS =
+endif

prg/extras.f90

@@ -97,7 +97,8 @@ subroutine rdpar(dtmp,version,s6,s18,rs6,rs18,alp)
       return
     end if
     ! read parameter file from home directory
-    call system('hostname > .tmpx')
+    !call system('hostname > .tmpx')
+    call execute_command_line('hostname > .tmpx')
     open(unit=43,file='.tmpx')
     read(43,'(a)')ftmp
     close(43,status='delete')
@@ -801,7 +802,8 @@ subroutine wregrad(nat,xyz,iat,edisp,g)
     close(42)
     close(43)
 
-    call system('mv gradient.tmp gradient')
+    !call system('mv gradient.tmp gradient')
+    call execute_command_line('mv gradient.tmp gradient')
 
     ! write file energy
     j=1
@@ -834,7 +836,8 @@ subroutine wregrad(nat,xyz,iat,edisp,g)
     close(42)
     close(43)
 
-    call system('mv energy.tmp energy')
+    !call system('mv energy.tmp energy')
+    call execute_command_line('mv energy.tmp energy')
 
   end subroutine wregrad
 

prg/main.f90

@@ -154,14 +154,17 @@ program dftd3_main
 
 
   ! get coord filename
-  call getarg(1,etmp)
+  !call getarg(1,etmp)
+  call get_command_argument(1,etmp)
   inquire(file=etmp,exist=ex)
   if (.not.ex) call printoptions
   ex=.false.
   ipot=0
   ! options
-  do i=1,iargc()
-    call getarg(i,ftmp)
+  !do i=1,iargc()
+  do i = 1, command_argument_count()
+    !call getarg(i,ftmp)
+    call get_command_argument(i, ftmp)
     if (index(ftmp,'-h') .ne.0) call printoptions
     if (index(ftmp,'-grad' ).ne.0) grad=.true.
     if (index(ftmp,'-anal' ).ne.0) anal=.true.
@@ -177,7 +180,8 @@ program dftd3_main
       minc6=.true.
       j=0
       do
-        call getarg(i+j+1,atmp)
+        !call getarg(i+j+1,atmp)
+        call get_command_argument(i+j+1,atmp)
         if (index(atmp,'-').eq.0.and.atmp.ne.'') then
           call elem(atmp,nn)
           if (nn.gt.max_elem.or.nn.lt.1) &
@@ -193,7 +197,8 @@ program dftd3_main
       maxc6=.true.
       k=0
       do
-        call getarg(i+k+1,atmp)
+        !call getarg(i+k+1,atmp)
+        call get_command_argument(i+k+1,atmp)
         if (index(atmp,'-').eq.0.and.atmp.ne.'') then
           call elem(atmp,nn)
           if (nn.gt.max_elem.or.nn.lt.1) &
@@ -207,25 +212,29 @@ program dftd3_main
     end if
     if (index(ftmp,'-pot') .ne.0) then
       pot=.true.
-      call getarg(i+1,atmp)
+      !call getarg(i+1,atmp)
+      call get_command_argument(i+1,atmp)
       call readl(atmp,xx,nn)
       ipot=idint(xx(1))
     end if
     if (index(ftmp,'-cnthr') .ne.0) then
-      call getarg(i+1,atmp)
+      !call getarg(i+1,atmp)
+      call get_command_argument(i+1,atmp)
       call readl(atmp,xx,nn)
       rthr2=xx(1)
       rthr2=rthr2**2
     end if
     if (index(ftmp,'-func') .ne.0) then
-      call getarg(i+1,func)
+      !call getarg(i+1,func)
+      call get_command_argument(i+1,func)
       ex=.true.
     end if
 
 
 
     if (index(ftmp,'-cutoff') .ne.0) then
-      call getarg(i+1,atmp)
+      !call getarg(i+1,atmp)
+      call get_command_argument(i+1,atmp)
       call readl(atmp,xx,nn)
       rthr=xx(1)**2
     end if
@@ -369,11 +378,11 @@ program dftd3_main
 
   ! output
   if (echo) then
-              write(*,'(/''#               XYZ [au]  '',12x,&
-     &              '' R0(AA) [Ang.]''2x,&
-     &              ''CN'',7x,&
-     &              ''C6(AA)     C8(AA)   C10(AA) [au] '')&
-     &            ')
+              write(*,"(/'#               XYZ [au]  ',12x,&
+     &              ' R0(AA) [Ang.]',2x,&
+     &              'CN',7x,&
+     &              'C6(AA)     C8(AA)   C10(AA) [au] ')&
+     &            ")
     x=0
     btmp=''
     do i=1,n
@@ -393,7 +402,7 @@ program dftd3_main
         atmp='f'
         btmp='f'
       end if
-      write(*,'(i4,3F10.5,3x,a2,1x,a1,F7.3,2x,F7.3,3F12.1,L)') &
+      write(*,'(i4,3F10.5,3x,a2,1x,a1,F7.3,2x,F7.3,3F12.1,L2)') &
           & i,xyz(1:3,i),esym(z),atmp, &
           & dum,cn(i), &
           & c6,c8,c10
@@ -576,7 +585,7 @@ program dftd3_main
     !      end if
     write(*,*)
     if (pbc) then
-      write(*,'('' Edisp /kcal,au,eV:'',f11.4,X,f12.8,X,f11.7)') &
+      write(*,'('' Edisp /kcal,au,eV:'',f11.4,1X,f12.8,1X,f11.7)') &
           & disp*autokcal,disp,disp*autoev
     else
       write(*,'('' Edisp /kcal,au:'',f11.4,f12.8)') disp*autokcal,disp
@@ -643,8 +652,8 @@ program dftd3_main
     ! check if gdisp yields same energy as edisp
     dum=abs((disp-gdsp)/disp)
     !if this check gives compiler errors, replace is with a different NaN ch
-    if (ISNAN(dum)) call stoprun('internal NaN-error')
-    ! if (dum/=dum) call stoprun('internal NaN-error')
+    !if (ISNAN(dum)) call stoprun('internal NaN-error')
+    if (dum/=dum) call stoprun('internal NaN-error')
     if (dum.gt.1.d-8) then
       write(*,*) disp,gdsp
       call stoprun('internal error')
@@ -756,7 +765,7 @@ program dftd3_main
         lat(j,i)=lat(j,i)+dum1
         call abc_to_xyz(abc,xyz,lat,n)
 
-        write(*,'("L"2i1,2E14.6)'),i,j,dum,g_lat(j,i)
+        write(*,'("L",2i1,2E14.6)') i,j,dum,g_lat(j,i)
         !j
       end do
       !i