Merge pull request #178 from ChemCryst/fix_crashes_on_error_conditions

Fix crashes on error conditions

Author: richardicooper

baregrep.exe

@@ -579,14 +579,24 @@ C
          MAXK=MAX(MAXK,IK)
          MAXL=MAX(MAXL,IL)
 C
-        if (( rf .lt. 9999. ).and.( rc .lt. 9999. )) then
-          write ( noutr, '(3I4,3F10.3)' )ih,ik,il,rf,rs, rc
+        if ( rf .lt. -999999. ) then
+          write ( noutr, '(A)') 
+     1    'F8 format overflow. fcf values too negative'
+          write ( noutr, '(3I4,3F12.0)' )ih,ik,il,rf,rs, rc
+        else if ( rf .lt. -99999. ) then
+          write ( noutr, '(3I4,3F8.0)' )ih,ik,il,rf,rs, rc
+        else if ( rf .lt. -9999. ) then
+          write ( noutr, '(3I4,3F8.1)' )ih,ik,il,rf,rs, rc
+        else if ( rf .lt. -999. ) then
+          write ( noutr, '(3I4,3F8.2)' )ih,ik,il,rf,rs, rc
+        else if (( rf .lt. 9999. ).and.( rc .lt. 9999. )) then
+          write ( noutr, '(3I4,3F8.3)' )ih,ik,il,rf,rs, rc
         else if (( rf .lt. 99999. ).and.( rc .lt. 99999. )) then
-          write ( noutr, '(3I4,3F10.2)' )ih,ik,il,rf,rs, rc
+          write ( noutr, '(3I4,3F8.2)' )ih,ik,il,rf,rs, rc
         else if (( rf .lt. 999999. ).and.( rc .lt. 999999. )) then
-          write ( noutr, '(3I4,3F10.1)' )ih,ik,il,rf,rs, rc
+          write ( noutr, '(3I4,3F8.1)' )ih,ik,il,rf,rs, rc
         else if (( rf .lt. 9999999. ).and.( rc .lt. 9999999. )) then
-          write ( noutr, '(3I4,3F10.0)' )ih,ik,il,rf,rs, rc
+          write ( noutr, '(3I4,3F8.0)' )ih,ik,il,rf,rs, rc
         else
           write ( noutr, '(A)') 
      1    'F8 format overflow. fcf values too big'
@@ -1273,7 +1283,7 @@ c2018        write(noutf,'(a)')'#OPEN FRN2 ARCHIVE-HKL.CIF'
           write(NOUTF,'(a)')'READ F''S=FO NCOEF=6 TYPE=FIXED CHECK=NO'
         end if
         write(NOUTF,'(a)')'INPUT H K L /FO/ SIGMA(/FO/) /Fc/'
-        write(NOUTF,'(a)')'FORMAT (3F4.0, 3F10.0)'
+        write(NOUTF,'(a)')'FORMAT (3F4.0, 3F8.0)'
         write(NOUTF,'(a)')'STORE NCOEF=7'
         write(NOUTF,'(a)')'OUTP INDI /FO/ SIG RATIO/J CORR SERI /Fc/'
         write(NOUTF,'(a)')'END'

bits/Diffractometers/datain.for

@@ -353,7 +353,7 @@ subroutine no_stdout_buffer() bind(c)
       if (i .le. 0) i=len_trim(output_name)+1
       lfr = i-1
       file_root = outfil(1:lfr)
-      output_hkl  = outfil(1:lfr)//'.hkl'
+      output_hkl  = outfil(1:lfr)//'v2.hkl'
 c
 c
 C....... Open our file for output of CRYSTALS instructions:
@@ -363,7 +363,7 @@ subroutine no_stdout_buffer() bind(c)
         call noillegal(option)    !remove illegal characters
         output_name = option(1:LEN_TRIM(option))//extbl
         outfil = output_name
-        output_hkl  = option(1:LEN_TRIM(option))//'.hkl'
+        output_hkl  = option(1:LEN_TRIM(option))//'v2.hkl'
         OPEN (NOUTF,FILE=output_name,STATUS='UNKNOWN')
         OPEN (NCIF,FILE=output_name(1:len_trim(output_name))//'.cif',
      1  STATUS='UNKNOWN')
@@ -375,7 +375,7 @@ subroutine no_stdout_buffer() bind(c)
 c     1    STATUS='UNKNOWN')
         end if
         output_hkl = file_root(1:lfr)
-        output_hkl(lfr+1:lfr+9) ='00000.hkl'
+        output_hkl(lfr+1:lfr+11) ='00000v2.hkl'
         write(output_hkl(lfr+1:lfr+5),  '(i5.5)') ndata
         write(ntext,'(a,a)')'HKL-file= ', output_hkl
       else
@@ -391,7 +391,7 @@ subroutine no_stdout_buffer() bind(c)
              lfn=12
             endif
          endif
-         output_hkl = output_name(1:lfn-4)//'.hkl'
+         output_hkl = output_name(1:lfn-4)//'v2.hkl'
          OPEN (NOUTF,FILE=output_name(1:lfn),STATUS='UNKNOWN')
 c         OPEN (NCIF,FILE=output_name(1:lfn-4)//'.cif',STATUS='UNKNOWN')
       end if

bits/Diffractometers/diffin.F

@@ -7522,6 +7522,18 @@ SUBROUTINE XBCALC(INTERN)
 C
 9900  CONTINUE
 C -- ERRORS
+      IF ( INTERN .NE. 2 ) THEN
+        IF ( KEXIST(41) .LE. 0 ) THEN
+C -- C R E A T E   A   N E W   L I S T   4 1:
+          IDWZAP = 0
+          CALL XFILL (IDWZAP, ICOM41, IDIM41)
+          N41B = 0 !Bond list, no entries
+          N41A = 0 !Atom list, no entries
+          N41D = 1 !Dependencies, one record.
+          CALL XCELST ( 41, ICOM41, IDIM41 )
+          CALL XWLSTD (41,ICOM41,IDIM41,-1,-1)
+        END IF
+      END IF
       CALL XOPMSG ( IOPBND , IOPABN , 0 )
       GOTO 3350
 9910  CONTINUE

crystals/distangl.F

@@ -368,6 +368,9 @@ SUBROUTINE XPRC12
 C--SET THE HEADER BLOCK LENGTHS
       LH121 = 3
       LH122=5
+C--SET THE INPUT AND OUTPUT LIST TYPES
+      KD=12
+      KE=22
 C--SET THE MAXIMUM NUMBER OF BLOCKS PLUS ONE
       MAXBLK=N22B
 C--SET THE MAXIMUM NUMBER OF 'EQUIVALENCES' PLUS ONE IN EACH BLOCK
@@ -554,9 +557,6 @@ SUBROUTINE XPRC12
       M5 = M5 + MD5
 100   CONTINUE
 C
-C--SET THE INPUT AND OUTPUT LIST TYPES
-      KD=12
-      KE=22
 C----- SET NO. OF 'GROUP' REFINEMENT DIRECTIVES TO ZERO
       NGPDIR = 0
       IF ( IERFLG .LT. 0 ) GO TO 9900

crystals/list12.F

@@ -457,8 +457,13 @@ SUBROUTINE XPRC16
 c      ICOM05(I)=NOWT
 c1050  CONTINUE
 C Load list 5 into core (allows checking during processing).
-       CALL XFAL05
-       IF(IERFLG .LT. 0) GOTO 9900
+      IF ( KEXIST(5) .GE. 1 ) THEN
+        CALL XFAL05
+        IF(IERFLG .LT. 0) GOTO 9900
+      ELSE
+        L5 = 0
+        N5 = 0
+      END IF
 
 C - Clear all the bits that restraints could possibly set.
       IMASK = NOT ( OR ( KBREFB(4), KBREFB(6) ))
@@ -2030,7 +2035,7 @@ SUBROUTINE XPRC16
       CALL XTCO(KE)
 
 CRICJUN03 - store the list 5, with modified Spare values.
-      CALL XSTR05 (5,-1,-1)
+      IF ( N5 .GT. 0 ) CALL XSTR05 (5,-1,-1)
 6020  CONTINUE
 
 

crystals/list16.F

@@ -1192,12 +1192,14 @@ SUBROUTINE XMOD05
         K5L = L5
         K5S = -MD5
       END IF
+      KCLASH = 0
 C  Outer loop over all but last atom.
       DO K5A = K5F,K5L-K5S,K5S
 C  Inner loop over atoms between current and last.
         DO K5B = K5A+K5S,K5L,K5S
           IF ( ( ISTORE(K5A)        .EQ. ISTORE(K5B)        ) .AND.
      1         ( NINT(STORE(K5A+1)) .EQ. NINT(STORE(K5B+1)) ) ) THEN
+           KCLASH = KCLASH + 1
            CALL CATSTR(STORE(K5A),STORE(K5A+1),1,1,0,0,0,CATOM1,LATOM1)
            call outcol(9)
            WRITE (CMON,'(''{I Clash detected, atom: '',A)')
@@ -1219,6 +1221,7 @@ SUBROUTINE XMOD05
         END DO
       END DO
       IERROR=IERNOP   ! This function should not cause a warning if no changes to L5.
+      ISTAT = KSCTRN ( 1 , 'EDIT:CLASH' , KCLASH, 1 )
       GO TO 100
 C
 C-C-C

crystals/modify5.F

@@ -1931,6 +1931,8 @@ FUNCTION KMERGE(IULN)
       IF(NREF-1)1000,1000,1050
 C--ONLY ONE CONTRIBUTOR
 1000  CONTINUE
+      ymode = 0.0
+	  sigmode = 0.0
       JFO=IFO+IREF
 C--IREF acts like M6 IN LOCAL STACK
       WORK(5) = STORE(JFO)                              !FO OR FOT

crystals/reductio.F

@@ -0,0 +1,24 @@
+%SCRIPT CLASHFIX
+% VARIABLE INTEGER EDIT:CLASH
+%%   variables used by the question box below  
+% VARIABLE CHARACTER QTITLE BUTTOK BUTTXX QLINE1 QLINE2  
+% VARIABLE LOGICAL ANSWER  
+% COPY '#EDIT'
+% COPY 'CLASH REPORT'
+% COPY 'END'
+% IF EDIT:CLASH .GT. 0 THEN
+%%  
+%    EVALUATE QTITLE = 'Duplicate atom name(s) detected'  
+%    EVALUATE QLINE1 = 'Found ' // CHARACTER EDIT:CLASH // ' duplicate atom names.'
+%    EVALUATE QLINE2 = 'Fix this now? Atoms will be renumbered.'  
+%    EVALUATE BUTTOK = '&Yes'  
+%    EVALUATE BUTTXX = '&No'  
+%    COPY '#SCRIPT XQUESTIO'  
+%    IF ANSWER .EQ. TRUE THEN  
+%      COPY '#EDIT'  
+%      COPY 'CLASH FIXLATTER'  
+%      COPY 'END'  
+{I Clashes fixed. Check your atom numbering scheme still has logical consistency.
+%    END IF  
+% END IF
+%END SCRIPT

script/clashfix.ssc

@@ -103,30 +103,28 @@ Files INITIAL.* will be created in your logs/ folder. They may be important.
 %    end if  
 %%  
 %    if ( exists 2 .eq. 1 ) .and. ( exists 5 .eq. 1 ) then  
-{S sort out atoms  
+{S Sort atoms and renumber H atoms.
 %% variables used by the question box below  
-%      VARIABLE CHARACTER QTITLE BUTTOK BUTTXX QLINE1 QLINE2  
-%      VARIABLE LOGICAL ANSWER  
-%%  
-%      EVALUATE QTITLE = 'Renumber Atoms?'  
-%      EVALUATE QLINE1 = 'Do you want to change atom numbers to CRYSTALS system?'  
-%      EVALUATE QLINE2 = 'This WILL invalidate any restraints imported from SHELXL.'  
-%      EVALUATE BUTTOK = '&Yes'  
-%      EVALUATE BUTTXX = '&No'  
-%      COPY '#SCRIPT XQUESTIO'  
-%      IF ANSWER .EQ. TRUE THEN  
-%        COPY '#EDIT'  
-%        COPY 'INSERT ELECTRON'  
-%        COPY 'DSORT SPARE'  
-%        COPY 'KEEP 1 ALL'  
-%        COPY 'END'  
-%        COPY '#SCRIPT XCENTRE'  
+%        VARIABLE CHARACTER QTITLE BUTTOK BUTTXX QLINE1 QLINE2  
+%        EVALUATE QTITLE = 'Renumber and recentre atoms?'  
+%        EVALUATE QLINE1 = 'Do you want to change hydrogen atom serials to CRYSTALS default?'  
+%        EVALUATE QLINE2 = 'This WILL invalidate any restraints imported from SHELXL.'  
+%        EVALUATE BUTTXX = '&Renumber'  
+%        EVALUATE BUTTOK = '&Leave unchanged'  
+%        COPY '#SCRIPT XQUESTIO'  
+%        IF ANSWER .EQ. FALSE THEN  
+%         COPY '#EDIT'  
+%         COPY 'INSERT ELECTRON'  
+%         COPY 'DSORT SPARE'  
+%         COPY 'KEEP 1 ALL'  
+%         COPY 'END'  
+%         COPY '#SCRIPT XCENTRE'  
 %% RESOLVE H ATOMS  
-%        COPY '#SCRIPT HNAM'  
-%        copy '#EDIT'  
-%        COPY 'SORT SERIAL'  
-%        COPY 'END'  
-%      END IF  
+%         COPY '#SCRIPT HNAM'  
+%         copy '#EDIT'  
+%         COPY 'SORT SERIAL'  
+%         COPY 'END'  
+%        END IF  
 %%  
 %    end if  
 %%  

script/diffexec.ssc

@@ -18,6 +18,8 @@
 %% _______________________________________________________________
 %%
 %  BLOCK
+%% quick check for clashing atom names
+%   COPY '#SCRIPT CLASHFIX'
 %% clear out the old ride and restraint files
 %   VARIABLE LOGICAL FD
 %   IF ( FILEEXISTS ( 'ridedat.12' ) ) THEN

script/xwrite5.ssc

@@ -190,7 +190,7 @@ END
     1 -13   0     302.80      4.92     38.64               2 $     6.96     54.64    303.50      0.02
 
 
-    1 -13   0     302.76     54.64     54.64               1 $    54.64     54.64    303.50      0.00
+    1 -13   0     302.76     54.64     54.64               1 $    54.64     54.64      0.00      0.00
 
                                                        338.56    -11.22     57.78      0.00   0.10E+01       0       5.9
                                                        361.00     11.22     59.66     22.44   0.10E+01       0       6.1

test_suite/LINUXGH.org/td-syst-sort.out

@@ -191,7 +191,7 @@ END
     1 -13   0     302.80      4.92     38.64               2 $     6.96     54.64    303.50      0.02
 
 
-    1 -13   0     302.76     54.64     54.64               1 $    54.64     54.64    303.50      0.00
+    1 -13   0     302.76     54.64     54.64               1 $    54.64     54.64      0.00      0.00
 
                                                        338.56    -11.22     57.78      0.00   0.10E+01       0       5.9
                                                        361.00     11.22     59.66     22.44   0.10E+01       0       6.1

test_suite/LINUXGHGUI.org/td-syst-sort.out

@@ -191,7 +191,7 @@ END
     1 -13   0     302.80      4.92     38.64               2 $     6.96     54.64    303.50      0.02
 
 
-    1 -13   0     302.76     54.64     54.64               1 $    54.64     54.64    303.50      0.00
+    1 -13   0     302.76     54.64     54.64               1 $    54.64     54.64      0.00      0.00
 
                                                        338.56    -11.22     57.78      0.00   0.10E+01       0       5.9
                                                        361.00     11.22     59.66     22.44   0.10E+01       0       6.1