diff --git a/src/kpoint_types.F b/src/kpoint_types.F index 1e4597d058..7260cba474 100644 --- a/src/kpoint_types.F +++ b/src/kpoint_types.F @@ -92,7 +92,7 @@ MODULE kpoint_types !> \author JGH ! ************************************************************************************************** TYPE kind_rotmat_type - REAL(KIND=dp), DIMENSION(:, :), POINTER :: rmat + REAL(KIND=dp), DIMENSION(:, :), POINTER :: rmat => NULL() END TYPE kind_rotmat_type ! ************************************************************************************************** diff --git a/src/kpsym.F b/src/kpsym.F index fddbb61245..fe10c4e9c6 100644 --- a/src/kpsym.F +++ b/src/kpsym.F @@ -169,13 +169,17 @@ SUBROUTINE k290s(iout, nat, nkpoint, nsp, iq1, iq2, iq3, istriz, & INTEGER :: i, ib(48), ib0(48), ihc, ihc0, ihg, ihg0, indpg, indpg0, invadd, istrin, iswght, & isy, isy0, itype, j, k, l, li, li0, lmax, n, nc, nc0, ntot, ntvec0 - INTEGER, DIMENSION(49, 1) :: f00 = 0 + INTEGER, DIMENSION(49, 1) :: f00 REAL(KIND=dp) :: a01(3), a02(3), a03(3), b01(3), b02(3), b03(3), b1(3), b2(3), b3(3), & dtotstr, origin(3), origin0(3), proj1, proj2, proj3, r(3, 3, 48), r0(3, 3, 48), totstr, & tvec0(3, 1), volum, vv0(3) - REAL(KIND=dp), DIMENSION(3, 1) :: x0 = 0._dp - REAL(KIND=dp), DIMENSION(3, 48) :: v = 0._dp, v0 = 0._dp + REAL(KIND=dp), DIMENSION(3, 1) :: x0 + REAL(KIND=dp), DIMENSION(3, 48) :: v, v0 + f00 = 0 + x0 = 0._dp + v = 0._dp + v0 = 0._dp ! ==--------------------------------------------------------------== ! READ IN LATTICE STRUCTURE ! ==--------------------------------------------------------------== @@ -202,11 +206,11 @@ SUBROUTINE k290s(iout, nat, nkpoint, nsp, iq1, iq2, iq3, istriz, & itype = itype + 1 IF (itype .GT. nsp) THEN IF (iout > 0) & - WRITE (6, '(A,I4,")")') & + WRITE (iout, '(A,I4,")")') & ' KPSYM| NUMBER OF ATOMIC TYPES EXCEEDS DIMENSION (NSP=)', & nsp IF (iout > 0) & - WRITE (6, '(" KPSYM| THE ARRAY TY IS:",/,9(1X,10I7,/))') & + WRITE (iout, '(" KPSYM| THE ARRAY TY IS:",/,9(1X,10I7,/))') & (ty(j), j=1, nat) CALL stopgm('K290', 'FATAL ERROR') END IF @@ -403,7 +407,7 @@ SUBROUTINE k290s(iout, nat, nkpoint, nsp, iq1, iq2, iq3, istriz, & IF (iout > 0) & WRITE (iout, '(" KPSYM| INVALID SWITCH FOR SYMMETRIZATION",I10)') istriz IF (iout > 0) & - WRITE (6, '(" KPSYM| INVALID SWITCH FOR SYMMETRIZATION",I10)') istriz + WRITE (iout, '(" KPSYM| INVALID SWITCH FOR SYMMETRIZATION",I10)') istriz CALL stopgm('K290', 'ISTRIZ WRONG ARGUMENT') END IF IF (iout > 0) & @@ -429,11 +433,11 @@ SUBROUTINE k290s(iout, nat, nkpoint, nsp, iq1, iq2, iq3, istriz, & ! We use only the rotations for Bravais lattices IF (ntvec .EQ. 1) THEN IF (iout > 0) & - WRITE (6, *) ' KPSYM| NUMBER OF ROTATIONS FOR BRAVAIS LATTICE', nc0 + WRITE (iout, *) ' KPSYM| NUMBER OF ROTATIONS FOR BRAVAIS LATTICE', nc0 IF (iout > 0) & - WRITE (6, *) ' KPSYM| NUMBER OF ROTATIONS FOR CRYSTAL LATTICE', nc + WRITE (iout, *) ' KPSYM| NUMBER OF ROTATIONS FOR CRYSTAL LATTICE', nc IF (iout > 0) & - WRITE (6, *) ' KPSYM| NO DUPLICATION FOUND' + WRITE (iout, *) ' KPSYM| NO DUPLICATION FOUND' CALL stopgm('ERROR', & 'SOMETHING IS WRONG IN GROUP DETERMINATION') END IF @@ -836,7 +840,7 @@ SUBROUTINE primlatt(a, ai, ap, api, nat, ty, x, ntvec, tvec, f0, isc, delta) f0(49, i) = i END DO DO k2 = 2, nat - IF (ty(1) .NE. ty(k2)) go to 100 + IF (ty(1) .NE. ty(k2)) GOTO 100 DO i = 1, 3 xb(i) = x(i, k2) - x(i, 1) END DO @@ -891,7 +895,7 @@ SUBROUTINE primlatt(a, ai, ap, api, nat, ty, x, ntvec, tvec, f0, isc, delta) END DO ! Calculate new API CALL calbrec(ap, api) - GOTO 200 + GOTO 200 ! EXIT END IF END IF END DO @@ -1224,7 +1228,7 @@ SUBROUTINE atftm1(iout, r, v, x, f0, origin, ib, ty, nat, ihg, ihc, & ! F0(49,1:NAT) has only inequivalent atom indexes for translation DO k2 = 1, nat IF (f0(49, k2) .LT. k2) GOTO 185 - IF (ty(1) .NE. ty(k2)) go to 185 + IF (ty(1) .NE. ty(k2)) GOTO 185 DO i = 1, 3 xb(i) = rx(i, 1) - x(i, k2) END DO @@ -1245,7 +1249,7 @@ SUBROUTINE atftm1(iout, r, v, x, f0, origin, ib, ty, nat, ihg, ihc, & 185 CONTINUE END DO iis(l) = 0 - go to 210 + GOTO 210 190 CONTINUE nca = nca + 1 DO i = 1, 3 @@ -1267,7 +1271,7 @@ SUBROUTINE atftm1(iout, r, v, x, f0, origin, ib, ty, nat, ihg, ihc, & li = 0 DO n = 1, nc l = ib(n) - IF (iis(l) .EQ. 0) go to 230 + IF (iis(l) .EQ. 0) GOTO 230 ! CYCLE i = i + 1 ib(i) = ib(n) IF (ib(i) .EQ. ni) li = i @@ -1296,7 +1300,7 @@ SUBROUTINE atftm1(iout, r, v, x, f0, origin, ib, ty, nat, ihg, ihc, & IF (ihg .LT. 6) THEN IF (nc .EQ. 0) THEN IF (iout > 0) & - WRITE (6, '(" ATFTM1! IHG=",A," NC=",I2)') icst(ihg), nC + WRITE (iout, '(" ATFTM1! IHG=",A," NC=",I2)') icst(ihg), nC CALL stopgm('ATFTM1', 'NUMBER OF ROTATION NULL') ! Triclinic system ELSEIF (nc .EQ. 1) THEN @@ -1439,7 +1443,7 @@ SUBROUTINE atftm1(iout, r, v, x, f0, origin, ib, ty, nat, ihg, ihc, & ELSEIF (ihg .GE. 6) THEN IF (nc .EQ. 0) THEN IF (iout > 0) & - WRITE (6, '(" ATFTM1! IHG=",A," NC=",I2)') icst(ihg), nC + WRITE (iout, '(" ATFTM1! IHG=",A," NC=",I2)') icst(ihg), nC CALL stopgm('ATFTM1', 'NUMBER OF ROTATION NULL') ! Triclinic system ELSEIF (nc .EQ. 1) THEN @@ -2255,7 +2259,7 @@ SUBROUTINE sppt2(iout, iq1, iq2, iq3, wvk0, nkpoint, & INTEGER, PARAMETER :: no = 0, nrsdir = 100 INTEGER :: i, i1, i2, i3, ibsign, igarb0, igarbage, & - igarbg, ii, imesh, iop, iplace = -2, & + igarbg, ii, imesh, iop, iplace, & iremov, iwvk, j, jplace, k, n, nplane REAL(dp) :: diff, proja(3), projb(3), & rsdir(4, nrsdir), ur1, ur2, ur3, & @@ -2640,7 +2644,7 @@ SUBROUTINE mesh(iout, wvk, iplace, igarb0, igarbg, & END DO ! List too long IF (iout > 0) & - WRITE (6, '(2A,/,A)') & + WRITE (iout, '(2A,/,A)') & ' SUBROUTINE MESH *** FATAL ERROR *** LINKED LIST', & ' TOO LONG ***', ' CHOOSE A BETTER HASH-FUNCTION' CALL stopgm('MESH', 'WARNING') @@ -2655,9 +2659,9 @@ SUBROUTINE mesh(iout, wvk, iplace, igarb0, igarbg, & list(ihash) = istore IF (istore .GT. nmesh) THEN IF (iout > 0) & - WRITE (6, '(A)') 'SUBROUTINE MESH *** FATAL ERROR ***' + WRITE (iout, '(A)') 'SUBROUTINE MESH *** FATAL ERROR ***' IF (iout > 0) & - WRITE (6, '(A,I10,A,/,A,3F10.5)') & + WRITE (iout, '(A,I10,A,/,A,3F10.5)') & ' ISTORE=', istore, ' EXCEEDS DIMENSIONS', & ' WVK = ', wvk CALL stopgm('MESH', 'WARNING') @@ -3030,7 +3034,6 @@ SUBROUTINE bzdefine(iout, b1, b2, b3, rsdir, nplane, delta) END DO ! 1/2*BVEC further confines the 1Bz - include into RSDIR nplane = nplane + 1 - ! WRITE(6,*)NPLANE,' PLANE INCLUDED, I1,2,3 = ',I1,I2,I3 CPASSERT(nplane <= nrsdir) DO i = 1, 3 rsdir(i, nplane) = bvec(i) diff --git a/tools/conventions/conventions.supp b/tools/conventions/conventions.supp index 6b216b10ff..44eaef61e5 100644 --- a/tools/conventions/conventions.supp +++ b/tools/conventions/conventions.supp @@ -77,6 +77,16 @@ hfx_energy_potential.F: Found WRITE statement with hardcoded unit in "print_inte input_enumeration_types.F: Found WRITE statement with hardcoded unit in "enum_i2c" https://cp2k.org/conv#c012 input_keyword_types.F: Found type keyword_type without initializer https://cp2k.org/conv#c016 input_parsing.F: Found WRITE statement with hardcoded unit in "section_vals_parse" https://cp2k.org/conv#c012 +kpsym.F: Found GOTO statement in procedure "atftm1" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "bzdefine" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "checkrlv3" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "garbag" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "k290s" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "mesh" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "pgl1" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "primlatt" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "remove" https://cp2k.org/conv#c201 +kpsym.F: Found GOTO statement in procedure "sppt2" https://cp2k.org/conv#c201 libcp2k.F: Found type eri2array without initializer https://cp2k.org/conv#c016 library_tests.F: Found CALL RANDOM_NUMBER in procedure "copy_test" https://cp2k.org/conv#c104 library_tests.F: Found CALL RANDOM_NUMBER in procedure "cp_fm_gemm_test" https://cp2k.org/conv#c104