libcp2k: use BLOCK stmts instead of GOTO

cp2k · Jun 7, 2019 · c6f2841 · c6f2841
1 parent ae870c9
commit c6f2841
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 45 deletions.
diff --git a/src/start/libcp2k.F b/src/start/libcp2k.F
@@ -430,16 +430,19 @@ INTEGER(C_INT) FUNCTION cp2k_active_space_get_mo_count(f_env_id) RESULT(nmo) BIN
 
       nmo = -1
       NULLIFY (f_env)
+
       CALL f_env_add_defaults(f_env_id, f_env)
 
-      CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
-      IF (.NOT. ASSOCIATED(active_space_env)) THEN
-         GOTO 999
-      END IF
+      try:BLOCK
+         CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
 
-      CALL get_mo_set(active_space_env%mos_active(1)%mo_set, nmo=nmo)
+         IF (.NOT. ASSOCIATED(active_space_env)) &
+            EXIT try
 
-999   CALL f_env_rm_defaults(f_env, ierr)
+         CALL get_mo_set(active_space_env%mos_active(1)%mo_set, nmo=nmo)
+      END BLOCK try
+
+      CALL f_env_rm_defaults(f_env, ierr)
       CPASSERT(ierr == 0)
    END FUNCTION cp2k_active_space_get_mo_count
 
@@ -469,30 +472,31 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_fock_sub(f_env_id, buf, buf_len)
       NULLIFY (f_env)
 
       CALL f_env_add_defaults(f_env_id, f_env)
-      CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
 
-      IF (.NOT. ASSOCIATED(active_space_env)) THEN
-         GOTO 999
-      END IF
+      try:BLOCK
+         CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
 
-      CALL get_mo_set(active_space_env%mos_active(1)%mo_set, nmo=norb)
+         IF (.NOT. ASSOCIATED(active_space_env)) &
+            EXIT try
 
-      IF (buf_len < norb*norb) THEN
-         GOTO 999
-      END IF
+         CALL get_mo_set(active_space_env%mos_active(1)%mo_set, nmo=norb)
 
-      DO i = 0, norb-1
-         DO j = 0, norb-1
-            CALL cp_fm_get_element(active_space_env%fock_sub(1)%matrix, i+1, j+1, mval)
-            buf(norb*i+j) = mval
-            buf(norb*j+i) = mval
+         IF (buf_len < norb*norb) &
+            EXIT try
+
+         DO i = 0, norb-1
+            DO j = 0, norb-1
+               CALL cp_fm_get_element(active_space_env%fock_sub(1)%matrix, i+1, j+1, mval)
+               buf(norb*i+j) = mval
+               buf(norb*j+i) = mval
+            END DO
          END DO
-      END DO
 
-      ! finished successfully, set number of written elements
-      nelem = norb**norb
+         ! finished successfully, set number of written elements
+         nelem = norb**norb
+      END BLOCK try
 
-999   CALL f_env_rm_defaults(f_env, ierr)
+      CALL f_env_rm_defaults(f_env, ierr)
       CPASSERT(ierr == 0)
    END FUNCTION cp2k_active_space_get_fock_sub
 
@@ -515,15 +519,17 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_eri_nze_count(f_env_id) RESULT(nz
       NULLIFY (f_env)
 
       CALL f_env_add_defaults(f_env_id, f_env)
-      CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
 
-      IF (.NOT. ASSOCIATED(active_space_env)) THEN
-         GOTO 999
-      END IF
+      try:BLOCK
+         CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
 
-      nze_count = active_space_env%eri%eri(1)%csr_mat%nze_total
+         IF (.NOT. ASSOCIATED(active_space_env)) &
+            EXIT try
 
-999   CALL f_env_rm_defaults(f_env, ierr)
+         nze_count = active_space_env%eri%eri(1)%csr_mat%nze_total
+      END BLOCK try
+
+      CALL f_env_rm_defaults(f_env, ierr)
       CPASSERT(ierr == 0)
    END FUNCTION cp2k_active_space_get_eri_nze_count
 
@@ -557,23 +563,24 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_eri(f_env_id, &
       NULLIFY (f_env)
 
       CALL f_env_add_defaults(f_env_id, f_env)
-      CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
 
-      IF (.NOT. ASSOCIATED(active_space_env)) THEN
-         GOTO 999
-      END IF
+      try:BLOCK
+         CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
+
+         IF (.NOT. ASSOCIATED(active_space_env)) &
+            EXIT try
 
-      ASSOCIATE (nze=>active_space_env%eri%eri(1)%csr_mat%nze_total)
-         IF (buf_coords_len < 4*nze .OR. buf_values_len < nze) THEN
-            GOTO 999
-         END IF
+         ASSOCIATE (nze=>active_space_env%eri%eri(1)%csr_mat%nze_total)
+            IF (buf_coords_len < 4*nze .OR. buf_values_len < nze) &
+               EXIT try
 
-         CALL active_space_env%eri%eri_foreach(1, eri2array(buf_coords, buf_values))
+            CALL active_space_env%eri%eri_foreach(1, eri2array(buf_coords, buf_values))
 
-         nelem = nze
-      END ASSOCIATE
+            nelem = nze
+         END ASSOCIATE
+      END BLOCK try
 
-999   CALL f_env_rm_defaults(f_env, ierr)
+      CALL f_env_rm_defaults(f_env, ierr)
       CPASSERT(ierr == 0)
    END FUNCTION cp2k_active_space_get_eri
 

diff --git a/tools/conventions/conventions.supp b/tools/conventions/conventions.supp
@@ -145,10 +145,6 @@ hfx_compression_methods.F: Found READ with unchecked STAT in "hfx_decompress_cac
 hfx_energy_potential.F: Found WRITE statement with hardcoded unit in "print_integrals"
 input_enumeration_types.F: Found WRITE statement with hardcoded unit in "enum_i2c"
 input_parsing.F: Found WRITE statement with hardcoded unit in "section_vals_parse"
-libcp2k.F: Found GOTO statement in procedure "cp2k_active_space_get_eri"
-libcp2k.F: Found GOTO statement in procedure "cp2k_active_space_get_eri_nze_count"
-libcp2k.F: Found GOTO statement in procedure "cp2k_active_space_get_fock_sub"
-libcp2k.F: Found GOTO statement in procedure "cp2k_active_space_get_mo_count"
 library_tests.F: Found CALL RANDOM_NUMBER in procedure "copy_test"
 library_tests.F: Found CALL RANDOM_NUMBER in procedure "cp_fm_gemm_test"
 library_tests.F: Found CALL RANDOM_NUMBER in procedure "fft_test"