Remove pseudo exception handling (Vedran Miletic)

svn-origin-rev: 15576

Author: oschuett

src/aobasis/ai_moments.F

@@ -1517,64 +1517,63 @@ SUBROUTINE dipole_force(la_max,npgfa,zeta,rpgfa,la_min,&
 
     failure = .FALSE.
     CPPrecondition(order==1,cp_failure_level,routineP,error,failure)
-    IF (.NOT. failure) THEN
-      rab = rbc - rac
-      rab2= SUM( rab**2 )
-      dab = SQRT(rab2)
+
+    rab = rbc - rac
+    rab2= SUM( rab**2 )
+    dab = SQRT(rab2)
 
-      lda_min = MAX ( 0, la_min-1 )
-      ldb_min = MAX ( 0, lb_min-1 )
-      lmax = MAX(la_max+1,lb_max+1)
-      lda = ncoset(la_max)*npgfa
-      ldb = ncoset(lb_max)*npgfb
-      ALLOCATE(difmab(lda,ldb,3))
-      ALLOCATE(mab(npgfa*ncoset(la_max+1),npgfb*ncoset(lb_max+1),3))
-      mab = 0.0_dp
-      CALL moment(la_max+1,npgfa,zeta,rpgfa,lda_min,&
-                  lb_max+1,npgfb,zetb,rpgfb,1,rac,rbc,mab)
+    lda_min = MAX ( 0, la_min-1 )
+    ldb_min = MAX ( 0, lb_min-1 )
+    lmax = MAX(la_max+1,lb_max+1)
+    lda = ncoset(la_max)*npgfa
+    ldb = ncoset(lb_max)*npgfb
+    ALLOCATE(difmab(lda,ldb,3))
+    ALLOCATE(mab(npgfa*ncoset(la_max+1),npgfb*ncoset(lb_max+1),3))
+    mab = 0.0_dp
+    CALL moment(la_max+1,npgfa,zeta,rpgfa,lda_min,&
+                lb_max+1,npgfb,zetb,rpgfb,1,rac,rbc,mab)
 
-      DO imom = 1,3
-        difmab = 0.0_dp
-        CALL adbdr(la_max,npgfa,rpgfa,la_min,lb_max,npgfb,zetb,rpgfb,lb_min,&
-             dab,mab(:,:,imom),difmab(:,:,1),difmab(:,:,2),difmab(:,:,3))
-        na = 0
-        DO ipgf=1,npgfa
-          nb = 0
-          DO jpgf=1,npgfb
-              DO j=nb+ncoset(lb_min-1)+1,nb+ncoset(lb_max)
-                DO i=na+ncoset(la_min-1)+1,na+ncoset(la_max)
+    DO imom = 1,3
+      difmab = 0.0_dp
+      CALL adbdr(la_max,npgfa,rpgfa,la_min,lb_max,npgfb,zetb,rpgfb,lb_min,&
+           dab,mab(:,:,imom),difmab(:,:,1),difmab(:,:,2),difmab(:,:,3))
+      na = 0
+      DO ipgf=1,npgfa
+         nb = 0
+         DO jpgf=1,npgfb
+            DO j=nb+ncoset(lb_min-1)+1,nb+ncoset(lb_max)
+               DO i=na+ncoset(la_min-1)+1,na+ncoset(la_max)
                   forceb(imom,1) = forceb(imom,1) + pab(i,j)*difmab(i,j,1)
                   forceb(imom,2) = forceb(imom,2) + pab(i,j)*difmab(i,j,2)
                   forceb(imom,3) = forceb(imom,3) + pab(i,j)*difmab(i,j,3)
-                END DO
-              END DO
-            nb = nb + ncoset(lb_max)
-          END DO
-          na = na + ncoset(la_max)
-        END DO
+               END DO
+            END DO
+         nb = nb + ncoset(lb_max)
+         END DO
+         na = na + ncoset(la_max)
+      END DO
 
-        difmab = 0.0_dp
-        CALL dabdr(la_max,npgfa,zeta,rpgfa,la_min,lb_max,npgfb,rpgfb,lb_min,&
-             dab,mab(:,:,imom),difmab(:,:,1),difmab(:,:,2),difmab(:,:,3))
-        na = 0
-        DO ipgf=1,npgfa
-          nb = 0
-          DO jpgf=1,npgfb
-              DO j=nb+ncoset(lb_min-1)+1,nb+ncoset(lb_max)
-                DO i=na+ncoset(la_min-1)+1,na+ncoset(la_max)
-                  forcea(imom,1) = forcea(imom,1) + pab(i,j)*difmab(i,j,1)
-                  forcea(imom,2) = forcea(imom,2) + pab(i,j)*difmab(i,j,2)
-                  forcea(imom,3) = forcea(imom,3) + pab(i,j)*difmab(i,j,3)
-                END DO
+      difmab = 0.0_dp
+      CALL dabdr(la_max,npgfa,zeta,rpgfa,la_min,lb_max,npgfb,rpgfb,lb_min,&
+           dab,mab(:,:,imom),difmab(:,:,1),difmab(:,:,2),difmab(:,:,3))
+      na = 0
+      DO ipgf=1,npgfa
+        nb = 0
+        DO jpgf=1,npgfb
+           DO j=nb+ncoset(lb_min-1)+1,nb+ncoset(lb_max)
+              DO i=na+ncoset(la_min-1)+1,na+ncoset(la_max)
+                 forcea(imom,1) = forcea(imom,1) + pab(i,j)*difmab(i,j,1)
+                 forcea(imom,2) = forcea(imom,2) + pab(i,j)*difmab(i,j,2)
+                 forcea(imom,3) = forcea(imom,3) + pab(i,j)*difmab(i,j,3)
               END DO
-            nb = nb + ncoset(lb_max)
-          END DO
-          na = na + ncoset(la_max)
+           END DO
+           nb = nb + ncoset(lb_max)
         END DO
+        na = na + ncoset(la_max)
       END DO
+    END DO
 
-      DEALLOCATE(mab,difmab)
-    END IF
+    DEALLOCATE(mab,difmab)
 
   END SUBROUTINE dipole_force