Work on coding conventions, add some GOTO suppressions (cp2k#3489)

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
 
 ! **************************************************************************************************

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)

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