hdiff output

r32056/sqnm.f90 2017-03-09 09:30:13.326025850 +0000 r32055/sqnm.f90 2017-03-09 09:30:13.594029421 +0000
470:                 do i=1,min(writemax,numcoords)470:                 do i=1,min(writemax,numcoords)
471:                     write(*, '(f16.10)', advance='no') (graddisp(i,j),j=1,nhist)471:                     write(*, '(f16.10)', advance='no') (graddisp(i,j),j=1,nhist)
472:                     write(*,*) ""472:                     write(*,*) ""
473:                 end do   473:                 end do   
474:             end if 474:             end if 
475: 475: 
476:             !FIND NORMS AND NORMALIZE X-DISPLACEMENT VECTORS476:             !FIND NORMS AND NORMALIZE X-DISPLACEMENT VECTORS
477:             allocate(norms(nhist))477:             allocate(norms(nhist))
478:             do i=1, nhist 478:             do i=1, nhist 
479:                 norms(i)=norm(numcoords,xdisp(:,i))479:                 norms(i)=norm(numcoords,xdisp(:,i))
480:                 if (norms(i)<1.0d-50) then !floating point errors caused underflow. Return to avoid division by 0.480:                 if (norms(i)<1.0d-100) then !floating point errors caused underflow. Return to avoid division by 0.
481:                     if (debug_run  .and. SQNM_DEBUGLEVEL>=0) print *,'Norm too small for division on run ',runs,', iter,',iter,&481:                     if (debug_run  .and. SQNM_DEBUGLEVEL>=0) print *,'Norm too small for division on run ',runs,', iter,',iter,&
482:                         'hist ', nhist, ' Bombing out...'482:                         'hist ', nhist, ' Bombing out...'
483:                     converget=.false.483:                     converget=.false.
484:                     return484:                     return
485:                 end if485:                 end if
486:                 !non-normalized x-displacements will not be needed again, so we can normalize in original matrix.486:                 !non-normalized x-displacements will not be needed again, so we can normalize in original matrix.
487:                 xdisp(:,i)=xdisp(:,i)/norms(i)487:                 xdisp(:,i)=xdisp(:,i)/norms(i)
488:             end do488:             end do
489: 489: 
490:             if (debug_run .and. SQNM_DEBUGLEVEL>=2) then 490:             if (debug_run .and. SQNM_DEBUGLEVEL>=2) then 
682:                 write(*, '(2A)') 'residues     ', ' Adjusted eigenvalues'682:                 write(*, '(2A)') 'residues     ', ' Adjusted eigenvalues'
683:                 do i=1,min(writemax,ndim)683:                 do i=1,min(writemax,ndim)
684:                     write(*, '(i3,a,f12.5,A,g15.7)') i,': ', residues(i), ' ', eigenvalues(i)684:                     write(*, '(i3,a,f12.5,A,g15.7)') i,': ', residues(i), ' ', eigenvalues(i)
685:                 end do 685:                 end do 
686:             end if686:             end if
687: 687: 
688: 688: 
689:             !FORM SUBSPACE PORTION OF PRECONDITIONED GRADIENT689:             !FORM SUBSPACE PORTION OF PRECONDITIONED GRADIENT
690:             pregrad(:)=0.0D0690:             pregrad(:)=0.0D0
691:             do i=1, ndim691:             do i=1, ndim
692:                 if (eigenvalues(i)<1.0d-50) return 
693:                 tempval=dot(numcoords,grad,principals(:,i))/eigenvalues(i)692:                 tempval=dot(numcoords,grad,principals(:,i))/eigenvalues(i)
694:                 pregrad(:)=pregrad(:)+tempval*principals(:,i)693:                 pregrad(:)=pregrad(:)+tempval*principals(:,i)
695:             end do694:             end do
696:             if (debug_run .and. SQNM_DEBUGLEVEL>=3) then 695:             if (debug_run .and. SQNM_DEBUGLEVEL>=3) then 
697:                 write(*, '(A)') 'Preconditioned Gradient in Subspace'696:                 write(*, '(A)') 'Preconditioned Gradient in Subspace'
698:                 do i=1,min(writemax,numcoords)697:                 do i=1,min(writemax,numcoords)
699:                     write(*, '(f16.10)', advance='no') pregrad(i)698:                     write(*, '(f16.10)', advance='no') pregrad(i)
700:                     write(*,*) ""699:                     write(*,*) ""
701:                 end do700:                 end do
702:             end if701:             end if
1052: ! STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP.1051: ! STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP.
1053: ! INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: IF INFO = 1,2,3,4,5, THEN THE STEP HAS BEEN COMPUTED1052: ! INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: IF INFO = 1,2,3,4,5, THEN THE STEP HAS BEEN COMPUTED
1054: ! ACCORDING TO ONE OF THE FIVE CASES BELOW. OTHERWISE INFO = 0, AND THIS INDICATES IMPROPER INPUT PARAMETERS.1053: ! ACCORDING TO ONE OF THE FIVE CASES BELOW. OTHERWISE INFO = 0, AND THIS INDICATES IMPROPER INPUT PARAMETERS.
1055: ! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 JORGE J. MORE', DAVID J. THUENTE1054: ! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 JORGE J. MORE', DAVID J. THUENTE
1056: 1055: 
1057:     DOUBLE PRECISION GAMMA,P,Q,R,S,SGND,STPC,STPF,STPQ,THETA1056:     DOUBLE PRECISION GAMMA,P,Q,R,S,SGND,STPC,STPF,STPQ,THETA
1058:     INFO = 01057:     INFO = 0
1059: 1058: 
1060:     ! CHECK THE INPUT PARAMETERS FOR ERRORS.1059:     ! CHECK THE INPUT PARAMETERS FOR ERRORS.
1061:     IF ((BRACKT .AND. (STP <= MIN(STX,STY) .OR. STP >= MAX(STX,STY))) .OR. DX*(STP-STX) >= 0.0 .OR. STPMAX < STPMIN) RETURN1060:     IF ((BRACKT .AND. (STP <= MIN(STX,STY) .OR. STP >= MAX(STX,STY))) .OR. DX*(STP-STX) >= 0.0 .OR. STPMAX < STPMIN) RETURN
1062:     1061: 
1063:     ! DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN.1062:     ! DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN.
1064:     SGND = DP*(DX/ABS(DX))1063:     SGND = DP*(DX/ABS(DX))
1065: 1064: 
1066:     ! FIRST CASE. A HIGHER FUNCTION VALUE. THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER TO STX THAN THE QUADRATIC STEP, 1065:     ! FIRST CASE. A HIGHER FUNCTION VALUE. THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER TO STX THAN THE QUADRATIC STEP, 
1067:     ! THE CUBIC STEP IS TAKEN, ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN.1066:     ! THE CUBIC STEP IS TAKEN, ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN.
1068:     cases: IF (FP .GT. FX) THEN1067:     cases: IF (FP .GT. FX) THEN
1069:         if ((STP - STX)==0.0d0) then  
1070:             info=0 
1071:             return 
1072:         endif 
1073:         INFO = 11068:         INFO = 1
1074:         BOUND = .TRUE.1069:         BOUND = .TRUE.
1075:         THETA = 3*(FX - FP)/(STP - STX) + DX + DP1070:         THETA = 3*(FX - FP)/(STP - STX) + DX + DP
1076:         S = MAX(ABS(THETA),ABS(DX),ABS(DP))1071:         S = MAX(ABS(THETA),ABS(DX),ABS(DP))
1077:         if (s==0.0d0) then  
1078:             info=0 
1079:             return 
1080:         endif 
1081:         GAMMA = S*SQRT((THETA/S)**2 - (DX/S)*(DP/S))1072:         GAMMA = S*SQRT((THETA/S)**2 - (DX/S)*(DP/S))
1082:         IF (STP .LT. STX) GAMMA = -GAMMA1073:         IF (STP .LT. STX) GAMMA = -GAMMA
1083:         P = (GAMMA - DX) + THETA1074:         P = (GAMMA - DX) + THETA
1084:         Q = ((GAMMA - DX) + GAMMA) + DP1075:         Q = ((GAMMA - DX) + GAMMA) + DP
1085:         if (q==0.0d0) then  
1086:             info=0 
1087:             return 
1088:         endif 
1089:         R = P/Q1076:         R = P/Q
1090:         STPC = STX + R*(STP - STX)1077:         STPC = STX + R*(STP - STX)
1091:         STPQ = STX + ((DX/((FX-FP)/(STP-STX)+DX))/2)*(STP - STX)1078:         STPQ = STX + ((DX/((FX-FP)/(STP-STX)+DX))/2)*(STP - STX)
1092:         IF (ABS(STPC-STX) .LT. ABS(STPQ-STX)) THEN1079:         IF (ABS(STPC-STX) .LT. ABS(STPQ-STX)) THEN
1093:             STPF = STPC1080:             STPF = STPC
1094:         ELSE1081:         ELSE
1095:             STPF = STPC + (STPQ - STPC)/21082:             STPF = STPC + (STPQ - STPC)/2
1096:         END IF1083:         END IF
1097:         BRACKT = .TRUE.1084:         BRACKT = .TRUE.
1098: 1085: 
1099:     ! SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC1086:     ! SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC
1100:     ! STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN.1087:     ! STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN.
1101:     ELSE IF (SGND .LT. 0.0) THEN cases1088:     ELSE IF (SGND .LT. 0.0) THEN cases
1102:         INFO = 21089:         INFO = 2
1103:         if ((STP - STX)==0.0d0) then  
1104:             info=0 
1105:             return 
1106:         endif 
1107:         BOUND = .FALSE.1090:         BOUND = .FALSE.
1108:         THETA = 3*(FX - FP)/(STP - STX) + DX + DP1091:         THETA = 3*(FX - FP)/(STP - STX) + DX + DP
1109:         S = MAX(ABS(THETA),ABS(DX),ABS(DP))1092:         S = MAX(ABS(THETA),ABS(DX),ABS(DP))
1110:         if (s==0.0d0) then  
1111:             info=0 
1112:             return 
1113:         endif 
1114:         GAMMA = S*SQRT((THETA/S)**2 - (DX/S)*(DP/S))1093:         GAMMA = S*SQRT((THETA/S)**2 - (DX/S)*(DP/S))
1115:         IF (STP .GT. STX) GAMMA = -GAMMA1094:         IF (STP .GT. STX) GAMMA = -GAMMA
1116:         P = (GAMMA - DP) + THETA1095:         P = (GAMMA - DP) + THETA
1117:         Q = ((GAMMA - DP) + GAMMA) + DX1096:         Q = ((GAMMA - DP) + GAMMA) + DX
1118:         if (q==0.0d0) then  
1119:             info=0 
1120:             return 
1121:         endif 
1122:         R = P/Q1097:         R = P/Q
1123:         if ((DP-DX)==0.0d0) then  
1124:             info=0 
1125:             return 
1126:         endif 
1127:         STPC = STP + R*(STX - STP)1098:         STPC = STP + R*(STX - STP)
1128:         STPQ = STP + (DP/(DP-DX))*(STX - STP)1099:         STPQ = STP + (DP/(DP-DX))*(STX - STP)
1129:         IF (ABS(STPC-STP) .GT. ABS(STPQ-STP)) THEN1100:         IF (ABS(STPC-STP) .GT. ABS(STPQ-STP)) THEN
1130:             STPF = STPC1101:             STPF = STPC
1131:         ELSE1102:         ELSE
1132:             STPF = STPQ1103:             STPF = STPQ
1133:         END IF1104:         END IF
1134:         BRACKT = .TRUE.1105:         BRACKT = .TRUE.
1135: 1106: 
1136:     ! THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. THE CUBIC1107:     ! THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. THE CUBIC
1137:     ! STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC IS BEYOND STP. 1108:     ! STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC IS BEYOND STP. 
1138:     ! OTHERWISE THE CUBIC STEP IS DEFINED TO BE EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO COMPUTED AND IF THE 1109:     ! OTHERWISE THE CUBIC STEP IS DEFINED TO BE EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO COMPUTED AND IF THE 
1139:     ! MINIMUM IS BRACKETED THEN THE THE STEP CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN.1110:     ! MINIMUM IS BRACKETED THEN THE THE STEP CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN.
1140:     ELSE IF (ABS(DP) .LT. ABS(DX)) THEN cases1111:     ELSE IF (ABS(DP) .LT. ABS(DX)) THEN cases
1141:         INFO = 31112:         INFO = 3
1142:         BOUND = .TRUE.1113:         BOUND = .TRUE.
1143:         if ((STP - STX)==0.0d0) then  
1144:             info=0 
1145:             return 
1146:         endif 
1147:         THETA = 3*(FX - FP)/(STP - STX) + DX + DP1114:         THETA = 3*(FX - FP)/(STP - STX) + DX + DP
1148:         S = MAX(ABS(THETA),ABS(DX),ABS(DP))1115:         S = MAX(ABS(THETA),ABS(DX),ABS(DP))
1149:         if (s==0.0d0) then  
1150:             info=0 
1151:             return 
1152:         endif 
1153:         !THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND TO INFINITY IN THE DIRECTION OF THE STEP.1116:         !THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND TO INFINITY IN THE DIRECTION OF THE STEP.
1154:         GAMMA = S*SQRT(MAX(0.0D0,(THETA/S)**2 - (DX/S)*(DP/S)))1117:         GAMMA = S*SQRT(MAX(0.0D0,(THETA/S)**2 - (DX/S)*(DP/S)))
1155:         IF (STP .GT. STX) GAMMA = -GAMMA1118:         IF (STP .GT. STX) GAMMA = -GAMMA
1156:         P = (GAMMA - DP) + THETA1119:         P = (GAMMA - DP) + THETA
1157:         Q = (GAMMA + (DX - DP)) + GAMMA1120:         Q = (GAMMA + (DX - DP)) + GAMMA
1158:         if (q==0.0d0) then  
1159:             info=0 
1160:             return 
1161:         endif 
1162:         R = P/Q1121:         R = P/Q
1163:         IF (R .LT. 0.0d0 .AND. GAMMA .NE. 0.0d0) THEN1122:         IF (R .LT. 0.0 .AND. GAMMA .NE. 0.0) THEN
1164:             STPC = STP + R*(STX - STP)1123:             STPC = STP + R*(STX - STP)
1165:         ELSE IF (STP .GT. STX) THEN1124:         ELSE IF (STP .GT. STX) THEN
1166:             STPC = STPMAX1125:             STPC = STPMAX
1167:         ELSE1126:         ELSE
1168:             STPC = STPMIN1127:             STPC = STPMIN
1169:         END IF1128:         END IF
1170:         if ((DP-DX)==0.0d0) then  
1171:             info=0 
1172:             return 
1173:         endif 
1174:         STPQ = STP + (DP/(DP-DX))*(STX - STP)1129:         STPQ = STP + (DP/(DP-DX))*(STX - STP)
1175:         IF (BRACKT) THEN1130:         IF (BRACKT) THEN
1176:             IF (ABS(STP-STPC) .LT. ABS(STP-STPQ)) THEN1131:             IF (ABS(STP-STPC) .LT. ABS(STP-STPQ)) THEN
1177:                 STPF = STPC1132:                 STPF = STPC
1178:             ELSE1133:             ELSE
1179:                 STPF = STPQ1134:                 STPF = STPQ
1180:             END IF1135:             END IF
1181:         ELSE1136:         ELSE
1182:             IF (ABS(STP-STPC) .GT. ABS(STP-STPQ)) THEN1137:             IF (ABS(STP-STPC) .GT. ABS(STP-STPQ)) THEN
1183:                 STPF = STPC1138:                 STPF = STPC
1185:                 STPF = STPQ1140:                 STPF = STPQ
1186:             END IF1141:             END IF
1187:         END IF1142:         END IF
1188: 1143: 
1189:     ! FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES1144:     ! FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES
1190:     ! NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN.1145:     ! NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN.
1191:     ELSE cases1146:     ELSE cases
1192:         INFO = 41147:         INFO = 4
1193:         BOUND = .FALSE.1148:         BOUND = .FALSE.
1194:         IF (BRACKT) THEN1149:         IF (BRACKT) THEN
1195:             if ((STY - STP)==0.0d0) then  
1196:                 info=0 
1197:                 return 
1198:             endif 
1199:             THETA = 3*(FP - FY)/(STY - STP) + DY + DP1150:             THETA = 3*(FP - FY)/(STY - STP) + DY + DP
1200:             S = MAX(ABS(THETA),ABS(DY),ABS(DP))1151:             S = MAX(ABS(THETA),ABS(DY),ABS(DP))
1201:             if (s==0.0d0) then  
1202:                 info=0 
1203:                 return 
1204:             endif 
1205:             GAMMA = S*SQRT((THETA/S)**2 - (DY/S)*(DP/S))1152:             GAMMA = S*SQRT((THETA/S)**2 - (DY/S)*(DP/S))
1206:             IF (STP .GT. STY) GAMMA = -GAMMA1153:             IF (STP .GT. STY) GAMMA = -GAMMA
1207:             P = (GAMMA - DP) + THETA1154:             P = (GAMMA - DP) + THETA
1208:             Q = ((GAMMA - DP) + GAMMA) + DY1155:             Q = ((GAMMA - DP) + GAMMA) + DY
1209:             if (q==0.0d0) then  
1210:                 info=0 
1211:                 return 
1212:             endif 
1213:             R = P/Q1156:             R = P/Q
1214:             STPC = STP + R*(STY - STP)1157:             STPC = STP + R*(STY - STP)
1215:             STPF = STPC1158:             STPF = STPC
1216:         ELSE IF (STP .GT. STX) THEN1159:         ELSE IF (STP .GT. STX) THEN
1217:             STPF = STPMAX1160:             STPF = STPMAX
1218:         ELSE1161:         ELSE
1219:             STPF = STPMIN1162:             STPF = STPMIN
1220:         END IF1163:         END IF
1221:     END IF cases1164:     END IF cases
1222: 1165: 
1223:     ! UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE.1166:     ! UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE.
1224:     IF (FP .GT. FX) THEN1167:     IF (FP .GT. FX) THEN
1225:         STY = STP1168:         STY = STP
1226:         FY = FP1169:         FY = FP
1227:         DY = DP1170:         DY = DP
1228:     ELSE1171:     ELSE
1229:         IF (SGND .LT. 0.0d0) THEN1172:         IF (SGND .LT. 0.0) THEN
1230:             STY = STX1173:             STY = STX
1231:             FY = FX1174:             FY = FX
1232:             DY = DX1175:             DY = DX
1233:             END IF1176:             END IF
1234:         STX = STP1177:         STX = STP
1235:         FX = FP1178:         FX = FP
1236:         DX = DP1179:         DX = DP
1237:     END IF1180:     END IF
1238: 1181: 
1239:     ! COMPUTE THE NEW STEP AND SAFEGUARD IT.1182:     ! COMPUTE THE NEW STEP AND SAFEGUARD IT.


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0