hdiff output

r33258/Ackland_metals.f90 2017-09-01 16:30:19.861051423 +0100 r33257/Ackland_metals.f90 2017-09-01 16:30:22.709089190 +0100
 10: !             Mfunc,Mfunc_d, Mfunc_dd,                                 * 10: !             Mfunc,Mfunc_d, Mfunc_dd,                                 *
 11: !             gfunc,gfunc_d,gfunc_dd                                   * 11: !             gfunc,gfunc_d,gfunc_dd                                   *
 12: !             Hfunc                                                    * 12: !             Hfunc                                                    *
 13: !             delta_dirac                                              * 13: !             delta_dirac                                              *
 14: !                                                                      * 14: !                                                                      *
 15: !****|******************************************************************| 15: !****|******************************************************************|
 16:  16: 
 17: !****|******************************************************************| 17: !****|******************************************************************|
 18: DOUBLE PRECISION FUNCTION rho_pot(ipot,R) 18: DOUBLE PRECISION FUNCTION rho_pot(ipot,R)
 19:   IMPLICIT DOUBLE PRECISION (a-h,o-z) 19:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
 20:   IMPLICIT INTEGER (I-N) 
 21:   DOUBLE PRECISION Rc 20:   DOUBLE PRECISION Rc
 22:   INCLUDE 'ackland_sma.h' 21:   INCLUDE 'ackland_sma.h'
 23:   INCLUDE 'ackland_mishin_cu.h' 22:   INCLUDE 'ackland_mishin_cu.h'
 24:   COMMON /param_cut_off/Rc 23:   COMMON /param_cut_off/Rc
 25:   INTEGER ipot 24:   INTEGER ipot
 26:   DOUBLE PRECISION  R 25:   DOUBLE PRECISION  R
 27:  26: 
 28:   !debug               write(*,*) '================================' 27:   !debug               write(*,*) '================================'
 29:   !debug        write(*,*) Rc 28:   !debug        write(*,*) Rc
 30:   !debig        stop 29:   !debig        stop
 52:   ENDIF 51:   ENDIF
 53:  52: 
 54:   RETURN 53:   RETURN
 55: END FUNCTION rho_pot 54: END FUNCTION rho_pot
 56:  55: 
 57:  56: 
 58: !****|******************************************************************| 57: !****|******************************************************************|
 59: !****|******************************************************************| 58: !****|******************************************************************|
 60: DOUBLE PRECISION FUNCTION rho_pot_d(ipot,R) 59: DOUBLE PRECISION FUNCTION rho_pot_d(ipot,R)
 61:   IMPLICIT DOUBLE PRECISION (a-h,o-z) 60:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
 62:   IMPLICIT INTEGER (I-N) 
 63:   DOUBLE PRECISION Rc 61:   DOUBLE PRECISION Rc
 64:   INCLUDE 'ackland_sma.h' 62:   INCLUDE 'ackland_sma.h'
 65:   INCLUDE 'ackland_mishin_cu.h' 63:   INCLUDE 'ackland_mishin_cu.h'
 66:   COMMON /param_cut_off/Rc 64:   COMMON /param_cut_off/Rc
 67:   DOUBLE PRECISION R 65:   DOUBLE PRECISION R
 68:   INTEGER ipot 66:   INTEGER ipot
 69:  67: 
 70:  68: 
 71:   IF(ipot.EQ.1.) THEN 69:   IF(ipot.EQ.1.) THEN
 72:      rho_pot_d=-(2*q)/Ro*EXP(-2*q*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)+     & 70:      rho_pot_d=-(2*q)/Ro*EXP(-2*q*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)+     &
100:      WRITE(*,*) 'erreur de ipot' 98:      WRITE(*,*) 'erreur de ipot'
101:      rho_pot_d=0.0D0 99:      rho_pot_d=0.0D0
102:   ENDIF100:   ENDIF
103: 101: 
104: 102: 
105:   RETURN103:   RETURN
106: END FUNCTION rho_pot_d104: END FUNCTION rho_pot_d
107: !****|******************************************************************|105: !****|******************************************************************|
108: DOUBLE PRECISION  FUNCTION rho_pot_dd(ipot,R)106: DOUBLE PRECISION  FUNCTION rho_pot_dd(ipot,R)
109:   IMPLICIT  DOUBLE PRECISION(a-h,o-z)107:   IMPLICIT  DOUBLE PRECISION(a-h,o-z)
110:   IMPLICIT INTEGER (I-N) 
111:   DOUBLE PRECISION Rc108:   DOUBLE PRECISION Rc
112:   INCLUDE 'ackland_sma.h'109:   INCLUDE 'ackland_sma.h'
113:   INCLUDE 'ackland_mishin_cu.h'110:   INCLUDE 'ackland_mishin_cu.h'
114:   COMMON /param_cut_off/Rc111:   COMMON /param_cut_off/Rc
115:   DOUBLE PRECISION R112:   DOUBLE PRECISION R
116:   INTEGER ipot113:   INTEGER ipot
117: 114: 
118: 115: 
119:   IF(ipot.EQ.1) THEN116:   IF(ipot.EQ.1) THEN
120:      rho_pot_dd=(2*q/Ro)**2*EXP(-2*q*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)        &117:      rho_pot_dd=(2*q/Ro)**2*EXP(-2*q*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)        &
150:   ELSE147:   ELSE
151:      WRITE(*,*) 'erreur de ipot'148:      WRITE(*,*) 'erreur de ipot'
152:      rho_pot_dd=0.0D0149:      rho_pot_dd=0.0D0
153:   ENDIF150:   ENDIF
154:   RETURN151:   RETURN
155: END FUNCTION rho_pot_dd152: END FUNCTION rho_pot_dd
156: 153: 
157: !****|******************************************************************|154: !****|******************************************************************|
158: DOUBLE PRECISION FUNCTION Vpot(ipot,R)155: DOUBLE PRECISION FUNCTION Vpot(ipot,R)
159:   IMPLICIT DOUBLE PRECISION (a-h,o-z)156:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
160:   IMPLICIT INTEGER (I-N) 
161:   DOUBLE PRECISION Rc157:   DOUBLE PRECISION Rc
162:   INCLUDE 'ackland_sma.h'158:   INCLUDE 'ackland_sma.h'
163:   INCLUDE 'ackland_mishin_cu.h'159:   INCLUDE 'ackland_mishin_cu.h'
164:   COMMON /param_cut_off/Rc160:   COMMON /param_cut_off/Rc
165:   INTEGER ipot161:   INTEGER ipot
166:   DOUBLE PRECISION Mfunc,R162:   DOUBLE PRECISION Mfunc,R
167: 163: 
168:   IF(ipot.EQ.1) THEN164:   IF(ipot.EQ.1) THEN
169:      Vpot=EXP(-p*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)165:      Vpot=EXP(-p*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)
170:      Vpot=a_r*Vpot166:      Vpot=a_r*Vpot
239:      WRITE(*,*) 'erreur de ipot'235:      WRITE(*,*) 'erreur de ipot'
240:      Vpot=0.0D0236:      Vpot=0.0D0
241: 237: 
242:   ENDIF238:   ENDIF
243: 239: 
244:   RETURN240:   RETURN
245: END FUNCTION Vpot241: END FUNCTION Vpot
246: !****|******************************************************************|242: !****|******************************************************************|
247: DOUBLE PRECISION FUNCTION Vpot_d(ipot,R)243: DOUBLE PRECISION FUNCTION Vpot_d(ipot,R)
248:   IMPLICIT DOUBLE PRECISION (a-h,o-z)244:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
249:   IMPLICIT INTEGER (I-N) 
250:   INCLUDE 'ackland_sma.h'245:   INCLUDE 'ackland_sma.h'
251:   INCLUDE 'ackland_mishin_cu.h'246:   INCLUDE 'ackland_mishin_cu.h'
252:   DOUBLE PRECISION Rc247:   DOUBLE PRECISION Rc
253:   COMMON /param_cut_off/Rc248:   COMMON /param_cut_off/Rc
254:   DOUBLE PRECISION Mfunc,Mfunc_d,R249:   DOUBLE PRECISION Mfunc,Mfunc_d,R
255:   INTEGER ipot250:   INTEGER ipot
256: 251: 
257: 252: 
258:   IF(ipot.EQ.1) THEN253:   IF(ipot.EQ.1) THEN
259: 254: 
336:      WRITE(*,*) 'erreur de ipot'331:      WRITE(*,*) 'erreur de ipot'
337:      Vpot_d=0.0D0332:      Vpot_d=0.0D0
338:   ENDIF333:   ENDIF
339: 334: 
340:   RETURN335:   RETURN
341: END FUNCTION Vpot_d336: END FUNCTION Vpot_d
342: 337: 
343: !****|******************************************************************|338: !****|******************************************************************|
344: DOUBLE PRECISION FUNCTION Vpot_dd(ipot,R)339: DOUBLE PRECISION FUNCTION Vpot_dd(ipot,R)
345:   IMPLICIT DOUBLE PRECISION (a-h,o-z)340:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
346:   IMPLICIT INTEGER (I-N) 
347:   INCLUDE 'ackland_sma.h'341:   INCLUDE 'ackland_sma.h'
348:   INCLUDE 'ackland_mishin_cu.h'342:   INCLUDE 'ackland_mishin_cu.h'
349:   DOUBLE PRECISION Rc343:   DOUBLE PRECISION Rc
350:   COMMON /param_cut_off/Rc344:   COMMON /param_cut_off/Rc
351:   DOUBLE PRECISION Mfunc,Mfunc_d,Mfunc_dd,R345:   DOUBLE PRECISION Mfunc,Mfunc_d,Mfunc_dd,R
352:   INTEGER ipot346:   INTEGER ipot
353: 347: 
354: 348: 
355:   IF(ipot.EQ.1) THEN349:   IF(ipot.EQ.1) THEN
356:      Vpot_dd=(p/Ro)**2*EXP(-p*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)      &350:      Vpot_dd=(p/Ro)**2*EXP(-p*(R/Ro-1.0d0))*fcut(ipot,R,Rc,delta)      &
390:      Vpot_dd=0.0D0384:      Vpot_dd=0.0D0
391:   ENDIF385:   ENDIF
392: 386: 
393:   RETURN387:   RETURN
394: END FUNCTION Vpot_dd388: END FUNCTION Vpot_dd
395: 389: 
396: 390: 
397: !****|******************************************************************|391: !****|******************************************************************|
398: DOUBLE PRECISION  FUNCTION fcut(ipot,R,Rc,width)392: DOUBLE PRECISION  FUNCTION fcut(ipot,R,Rc,width)
399:   IMPLICIT DOUBLE PRECISION (a-h,o-z)393:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
400:   IMPLICIT INTEGER (I-N) 
401:   DOUBLE PRECISION R,Rc,width,test,x394:   DOUBLE PRECISION R,Rc,width,test,x
402: 395: 
403:   fcut=0.0D0396:   fcut=0.0D0
404: 397: 
405:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN398:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN
406:      test=(R-Rc)/width399:      test=(R-Rc)/width
407:      IF(test.LT.-100.d0)  THEN400:      IF(test.LT.-100.d0)  THEN
408:         fcut=1.0d0401:         fcut=1.0d0
409:      ELSEIF(test.GT.100.d0) THEN402:      ELSEIF(test.GT.100.d0) THEN
410:         fcut=0.0d0403:         fcut=0.0d0
423:   ELSEIF ((ipot.EQ.5).OR.(ipot.EQ.6).OR.(ipot.EQ.12).OR.(ipot.EQ.13)) THEN416:   ELSEIF ((ipot.EQ.5).OR.(ipot.EQ.6).OR.(ipot.EQ.12).OR.(ipot.EQ.13)) THEN
424:      fcut=1.d0417:      fcut=1.d0
425:   ENDIF418:   ENDIF
426: 419: 
427:   RETURN420:   RETURN
428: END FUNCTION fcut421: END FUNCTION fcut
429: 422: 
430: !****|******************************************************************|423: !****|******************************************************************|
431: DOUBLE PRECISION  FUNCTION fcut_d(ipot,R,Rc,width)424: DOUBLE PRECISION  FUNCTION fcut_d(ipot,R,Rc,width)
432:   IMPLICIT DOUBLE PRECISION (a-h,o-z)425:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
433:   IMPLICIT INTEGER (I-N) 
434:   DOUBLE PRECISION R,Rc,width,test,x426:   DOUBLE PRECISION R,Rc,width,test,x
435: 427: 
436:   fcut_d=0.0D0428:   fcut_d=0.0D0
437: 429: 
438:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN430:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN
439:      test=(R-Rc)/width431:      test=(R-Rc)/width
440:      IF(test.LT.-100.d0)  THEN432:      IF(test.LT.-100.d0)  THEN
441:         fcut_d=0.0d0433:         fcut_d=0.0d0
442:      ELSEIF(test.GT.100.d0) THEN434:      ELSEIF(test.GT.100.d0) THEN
443:         fcut_d=0.0d0435:         fcut_d=0.0d0
458:   ELSEIF ((ipot.EQ.5).OR.(ipot.EQ.6).OR.(ipot.EQ.12).OR.(ipot.EQ.13)) THEN450:   ELSEIF ((ipot.EQ.5).OR.(ipot.EQ.6).OR.(ipot.EQ.12).OR.(ipot.EQ.13)) THEN
459:      fcut_d=1.d0451:      fcut_d=1.d0
460:   ENDIF452:   ENDIF
461: 453: 
462:   RETURN454:   RETURN
463: END FUNCTION fcut_d455: END FUNCTION fcut_d
464: 456: 
465: !****|******************************************************************|457: !****|******************************************************************|
466: DOUBLE PRECISION FUNCTION fcut_dd(ipot,R,Rc,width)458: DOUBLE PRECISION FUNCTION fcut_dd(ipot,R,Rc,width)
467:   IMPLICIT  DOUBLE PRECISION(a-h,o-z)459:   IMPLICIT  DOUBLE PRECISION(a-h,o-z)
468:   IMPLICIT INTEGER (I-N) 
469:   DOUBLE PRECISION R,Rc,width,test,x460:   DOUBLE PRECISION R,Rc,width,test,x
470: 461: 
471:   fcut_dd=0.0D0462:   fcut_dd=0.0D0
472: 463: 
473:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN464:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN
474:      test=(R-Rc)/width465:      test=(R-Rc)/width
475:      IF(test.LT.-100.d0)  THEN466:      IF(test.LT.-100.d0)  THEN
476:         fcut_dd=0.0d0467:         fcut_dd=0.0d0
477:      ELSEIF(test.GT.100.d0) THEN468:      ELSEIF(test.GT.100.d0) THEN
478:         fcut_dd=0.0d0469:         fcut_dd=0.0d0
495: 486: 
496:   ENDIF487:   ENDIF
497: 488: 
498:   RETURN489:   RETURN
499: END FUNCTION fcut_dd490: END FUNCTION fcut_dd
500: 491: 
501: !****|******************************************************************|492: !****|******************************************************************|
502: DOUBLE PRECISION FUNCTION Fembed(ipot,x)493: DOUBLE PRECISION FUNCTION Fembed(ipot,x)
503:   USE COMMONS, ONLY : ACK1, ACK2494:   USE COMMONS, ONLY : ACK1, ACK2
504:   IMPLICIT DOUBLE PRECISION (a-h,o-z)495:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
505:   IMPLICIT INTEGER (I-N) 
506:   DOUBLE PRECISION x496:   DOUBLE PRECISION x
507:   INTEGER ipot497:   INTEGER ipot
508:   DOUBLE PRECISION Rc498:   DOUBLE PRECISION Rc
509:   COMMON /param_cut_off/Rc499:   COMMON /param_cut_off/Rc
510:   INCLUDE 'ackland_sma.h'500:   INCLUDE 'ackland_sma.h'
511:   INCLUDE 'ackland_mishin_cu.h'501:   INCLUDE 'ackland_mishin_cu.h'
512:   INCLUDE 'ackland_mendelev_fe.h'502:   INCLUDE 'ackland_mendelev_fe.h'
513: 503: 
514:   Fembed=0.0D0504:   Fembed=0.0D0
515: 505: 
553:           + 4.9758343293936d0*1.d-7*(x-90.d0)**4*Hfunc(x-90.d0)543:           + 4.9758343293936d0*1.d-7*(x-90.d0)**4*Hfunc(x-90.d0)
554: 544: 
555: 545: 
556:   END IF546:   END IF
557:   RETURN547:   RETURN
558: END FUNCTION Fembed548: END FUNCTION Fembed
559: !****|******************************************************************|549: !****|******************************************************************|
560: DOUBLE PRECISION FUNCTION Fembed_d(ipot,x)550: DOUBLE PRECISION FUNCTION Fembed_d(ipot,x)
561:   USE COMMONS, ONLY : ACK1, ACK2551:   USE COMMONS, ONLY : ACK1, ACK2
562:   IMPLICIT DOUBLE PRECISION (a-h,o-z)552:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
563:   IMPLICIT INTEGER (I-N) 
564:   DOUBLE PRECISION x553:   DOUBLE PRECISION x
565:   DOUBLE PRECISION Rc554:   DOUBLE PRECISION Rc
566:   COMMON /param_cut_off/Rc555:   COMMON /param_cut_off/Rc
567:   INCLUDE 'ackland_sma.h'556:   INCLUDE 'ackland_sma.h'
568:   INCLUDE 'ackland_mishin_cu.h'557:   INCLUDE 'ackland_mishin_cu.h'
569:   INCLUDE 'ackland_mendelev_fe.h'558:   INCLUDE 'ackland_mendelev_fe.h'
570: 559: 
571:   Fembed_d=0.0D0560:   Fembed_d=0.0D0
572: 561: 
573:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN562:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN
622: 611: 
623:   ENDIF612:   ENDIF
624: 613: 
625:   RETURN614:   RETURN
626: END FUNCTION Fembed_d615: END FUNCTION Fembed_d
627: 616: 
628: !****|******************************************************************|617: !****|******************************************************************|
629: DOUBLE PRECISION FUNCTION Fembed_dd(ipot,x)618: DOUBLE PRECISION FUNCTION Fembed_dd(ipot,x)
630:   USE COMMONS, ONLY : ACK1, ACK2619:   USE COMMONS, ONLY : ACK1, ACK2
631:   IMPLICIT DOUBLE PRECISION (a-h,o-z)620:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
632:   IMPLICIT INTEGER (I-N) 
633:   INCLUDE 'ackland_sma.h'621:   INCLUDE 'ackland_sma.h'
634:   INCLUDE 'ackland_mishin_cu.h'622:   INCLUDE 'ackland_mishin_cu.h'
635:   DOUBLE PRECISION Rc623:   DOUBLE PRECISION Rc
636:   COMMON /param_cut_off/Rc624:   COMMON /param_cut_off/Rc
637:   DOUBLE PRECISION x,denom625:   DOUBLE PRECISION x,denom
638:   INCLUDE 'ackland_mendelev_fe.h'626:   INCLUDE 'ackland_mendelev_fe.h'
639: 627: 
640:   Fembed_dd=0.0D0628:   Fembed_dd=0.0D0
641: 629: 
642:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN630:   IF(ipot.EQ.1.OR.ipot.EQ.2.OR.ipot.EQ.3) THEN
760: !****|******************************************************************|748: !****|******************************************************************|
761: !****|******************************************************************|749: !****|******************************************************************|
762: !****|******************************************************************|750: !****|******************************************************************|
763: 751: 
764: 752: 
765: !****|******************************************************************|753: !****|******************************************************************|
766: !****|******************************************************************|754: !****|******************************************************************|
767: DOUBLE PRECISION FUNCTION fpsi(x)755: DOUBLE PRECISION FUNCTION fpsi(x)
768:   USE COMMONS, ONLY : ACK1, ACK2756:   USE COMMONS, ONLY : ACK1, ACK2
769:   IMPLICIT DOUBLE PRECISION (a-h,o-z)757:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
770:   IMPLICIT INTEGER (I-N) 
771:   INCLUDE 'ackland_mendelev_fe.h'758:   INCLUDE 'ackland_mendelev_fe.h'
772: 759: 
773:   temp = 0.d0760:   temp = 0.d0
774:   DO i=1,npsi761:   DO i=1,npsi
775:      temp = temp + ap(i)*Hfunc(rp(i)-x)*(rp(i)-x)**3762:      temp = temp + ap(i)*Hfunc(rp(i)-x)*(rp(i)-x)**3
776:   END DO763:   END DO
777:   fpsi = temp764:   fpsi = temp
778:   RETURN765:   RETURN
779: END FUNCTION fpsi766: END FUNCTION fpsi
780: !****|******************************************************************|767: !****|******************************************************************|
781: DOUBLE PRECISION FUNCTION fpsi_d(x)768: DOUBLE PRECISION FUNCTION fpsi_d(x)
782:   USE COMMONS, ONLY : ACK1, ACK2769:   USE COMMONS, ONLY : ACK1, ACK2
783:   IMPLICIT DOUBLE PRECISION (a-h,o-z)770:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
784:   IMPLICIT INTEGER (I-N) 
785:   INCLUDE 'ackland_mendelev_fe.h'771:   INCLUDE 'ackland_mendelev_fe.h'
786: 772: 
787:   temp = 0.d0773:   temp = 0.d0
788:   DO i=1,npsi774:   DO i=1,npsi
789:      temp = temp - 3.d0*ap(i)*Hfunc(rp(i)-x)*(rp(i)-x)**2775:      temp = temp - 3.d0*ap(i)*Hfunc(rp(i)-x)*(rp(i)-x)**2
790:   END DO776:   END DO
791:   fpsi_d = temp777:   fpsi_d = temp
792:   RETURN778:   RETURN
793: END FUNCTION fpsi_d779: END FUNCTION fpsi_d
794: !****|******************************************************************|780: !****|******************************************************************|
795: DOUBLE PRECISION FUNCTION fpsi_dd(x)781: DOUBLE PRECISION FUNCTION fpsi_dd(x)
796:   USE COMMONS, ONLY : ACK1, ACK2782:   USE COMMONS, ONLY : ACK1, ACK2
797:   IMPLICIT DOUBLE PRECISION (a-h,o-z)783:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
798:   IMPLICIT INTEGER (I-N) 
799:   INCLUDE 'ackland_mendelev_fe.h'784:   INCLUDE 'ackland_mendelev_fe.h'
800: 785: 
801:   temp = 0.d0786:   temp = 0.d0
802:   DO i=1,npsi787:   DO i=1,npsi
803:      temp = temp + 6.d0*ap(i)*Hfunc(rp(i)-x)*(rp(i)-x)788:      temp = temp + 6.d0*ap(i)*Hfunc(rp(i)-x)*(rp(i)-x)
804:   END DO789:   END DO
805:   fpsi_dd = temp790:   fpsi_dd = temp
806:   RETURN791:   RETURN
807: END FUNCTION fpsi_dd792: END FUNCTION fpsi_dd
808: !****|******************************************************************|793: !****|******************************************************************|
809: !****|******************************************************************|794: !****|******************************************************************|
810: DOUBLE PRECISION FUNCTION fvarphi (x)795: DOUBLE PRECISION FUNCTION fvarphi (x)
811:   USE COMMONS, ONLY : ACK1, ACK2796:   USE COMMONS, ONLY : ACK1, ACK2
812:   IMPLICIT DOUBLE PRECISION (a-h,o-z)797:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
813:   IMPLICIT INTEGER (I-N) 
814:   INCLUDE 'ackland_mendelev_fe.h'798:   INCLUDE 'ackland_mendelev_fe.h'
815: 799: 
816:   threei   =1.d0/3.d0800:   threei   =1.d0/3.d0
817:   ZnFE2   = ZnFE*ZnFE801:   ZnFE2   = ZnFE*ZnFE
818:   AU_TO_EV = hart802:   AU_TO_EV = hart
819:   AU_TO_A = abohr803:   AU_TO_A = abohr
820:   temp   = 0.d0804:   temp   = 0.d0
821: 805: 
822:   rs = 0.88534d0*abohr*ZnFE**(-threei)/dsqrt(2.d0)806:   rs = 0.88534d0*abohr*ZnFE**(-threei)/dsqrt(2.d0)
823:   rx = x/rs807:   rx = x/rs
832:      END DO816:      END DO
833:      fvarphi = temp817:      fvarphi = temp
834:   END IF818:   END IF
835: 819: 
836:   RETURN820:   RETURN
837: END FUNCTION fvarphi821: END FUNCTION fvarphi
838: !****|******************************************************************|822: !****|******************************************************************|
839: DOUBLE PRECISION FUNCTION fvarphi_d (x)823: DOUBLE PRECISION FUNCTION fvarphi_d (x)
840:   USE COMMONS, ONLY : ACK1, ACK2824:   USE COMMONS, ONLY : ACK1, ACK2
841:   IMPLICIT DOUBLE PRECISION (a-h,o-z)825:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
842:   IMPLICIT INTEGER (I-N) 
843:   INCLUDE 'ackland_mendelev_fe.h'826:   INCLUDE 'ackland_mendelev_fe.h'
844:   threei   = 1.d0/3.d0827:   threei   = 1.d0/3.d0
845:   ZnFE2   = ZnFE*ZnFE828:   ZnFE2   = ZnFE*ZnFE
846:   AU_TO_EV = hart829:   AU_TO_EV = hart
847:   AU_TO_A = abohr830:   AU_TO_A = abohr
848:   temp   = 0.d0831:   temp   = 0.d0
849: 832: 
850:   rs = 0.88534d0*abohr*ZnFE**(-threei)/dsqrt(2.d0)833:   rs = 0.88534d0*abohr*ZnFE**(-threei)/dsqrt(2.d0)
851:   rx = x/rs834:   rx = x/rs
852: 835: 
862:      END DO845:      END DO
863:      fvarphi_d = temp846:      fvarphi_d = temp
864:   END IF847:   END IF
865: 848: 
866:   RETURN849:   RETURN
867: END FUNCTION fvarphi_d850: END FUNCTION fvarphi_d
868: !****|******************************************************************|851: !****|******************************************************************|
869: DOUBLE PRECISION FUNCTION fvarphi_dd (x)852: DOUBLE PRECISION FUNCTION fvarphi_dd (x)
870:   USE COMMONS, ONLY : ACK1, ACK2853:   USE COMMONS, ONLY : ACK1, ACK2
871:   IMPLICIT DOUBLE PRECISION (a-h,o-z)854:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
872:   IMPLICIT INTEGER (I-N) 
873:   INCLUDE 'ackland_mendelev_fe.h'855:   INCLUDE 'ackland_mendelev_fe.h'
874:   threei   = 1.d0/3.d0856:   threei   = 1.d0/3.d0
875:   ZnFE2   = ZnFE*ZnFE857:   ZnFE2   = ZnFE*ZnFE
876:   AU_TO_EV = hart858:   AU_TO_EV = hart
877:   AU_TO_A = abohr859:   AU_TO_A = abohr
878:   temp   = 0.d0860:   temp   = 0.d0
879: 861: 
880:   rs = 0.88534d0*abohr*ZnFE**(-threei)/dsqrt(2.d0)862:   rs = 0.88534d0*abohr*ZnFE**(-threei)/dsqrt(2.d0)
881:   rx = x/rs863:   rx = x/rs
882: 864: 
937:   RETURN919:   RETURN
938: END FUNCTION fphi_dd920: END FUNCTION fphi_dd
939: 921: 
940: !****|******************************************************************|922: !****|******************************************************************|
941: !****|******************************************************************|923: !****|******************************************************************|
942: !****|******************************************************************|924: !****|******************************************************************|
943: !****|******************************************************************|925: !****|******************************************************************|
944: 926: 
945: SUBROUTINE BUILD_RHO_SITE(ipot,rho_site,Rn,ndir,nat_up,ndir_max)927: SUBROUTINE BUILD_RHO_SITE(ipot,rho_site,Rn,ndir,nat_up,ndir_max)
946:   IMPLICIT DOUBLE PRECISION (a-h,o-z)928:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
947:   IMPLICIT INTEGER (I-N) 
948:   DOUBLE PRECISION Rn(nat_up,ndir_max,3), rho_site(nat_up),    &929:   DOUBLE PRECISION Rn(nat_up,ndir_max,3), rho_site(nat_up),    &
949:        rho_temp,normR,R,Rtemp(3)930:        rho_temp,normR,R,Rtemp(3)
950:   INTEGER ndir(nat_up),nat_up,ndir_max,ipot931:   INTEGER ndir(nat_up),nat_up,ndir_max,ipot
951: 932: 
952: 933: 
953:   DO i=1,nat_up934:   DO i=1,nat_up
954:      rho_temp=0.0D0935:      rho_temp=0.0D0
955:      DO ni=1,ndir(i)936:      DO ni=1,ndir(i)
956:         Rtemp(:)=Rn(i,ni,:)937:         Rtemp(:)=Rn(i,ni,:)
957:         R=SQRT(DOT_PRODUCT(Rtemp,Rtemp))938:         R=SQRT(DOT_PRODUCT(Rtemp,Rtemp))
959:      END DO940:      END DO
960: 941: 
961:      rho_site(i)=rho_temp942:      rho_site(i)=rho_temp
962:   END DO943:   END DO
963: 944: 
964:   RETURN945:   RETURN
965: END SUBROUTINE BUILD_RHO_SITE946: END SUBROUTINE BUILD_RHO_SITE
966: !****|******************************************************************|947: !****|******************************************************************|
967: SUBROUTINE BUILD_V_SITE(ipot,V_site,Rn,ndir,nat_up,ndir_max)948: SUBROUTINE BUILD_V_SITE(ipot,V_site,Rn,ndir,nat_up,ndir_max)
968:   IMPLICIT DOUBLE PRECISION (a-h,o-z)949:   IMPLICIT DOUBLE PRECISION (a-h,o-z)
969:   IMPLICIT INTEGER (I-N) 
970:   DOUBLE PRECISION Rn(nat_up,ndir_max,3),V_site(nat_up),   &950:   DOUBLE PRECISION Rn(nat_up,ndir_max,3),V_site(nat_up),   &
971:        V_temp,normR,R,Rtemp(3)951:        V_temp,normR,R,Rtemp(3)
972:   INTEGER ndir(nat_up),nat_up,nat_max,ndir_max,ipot952:   INTEGER ndir(nat_up),nat_up,nat_max,ndir_max,ipot
973: 953: 
974: 954: 
975:   DO i=1,nat_up955:   DO i=1,nat_up
976:      V_temp=0.0D0956:      V_temp=0.0D0
977:      DO ni=1,ndir(i)957:      DO ni=1,ndir(i)
978:         Rtemp(:)=Rn(i,ni,:)958:         Rtemp(:)=Rn(i,ni,:)
979:         R=SQRT(DOT_PRODUCT(Rtemp,Rtemp))959:         R=SQRT(DOT_PRODUCT(Rtemp,Rtemp))


r33258/CMakeLists.txt 2017-09-01 16:30:20.085054394 +0100 r33257/CMakeLists.txt 2017-09-01 16:30:22.957092485 +0100
113: set(DUMMY_CPP_FLAGS "DUMMY_AMBER12;DUMMY_CUDA")113: set(DUMMY_CPP_FLAGS "DUMMY_AMBER12;DUMMY_CUDA")
114: 114: 
115: # Glob all the sources115: # Glob all the sources
116: file(GLOB GMIN_LIB_SOURCES *.f116: file(GLOB GMIN_LIB_SOURCES *.f
117:                            *.f90117:                            *.f90
118:                            *.F118:                            *.F
119:                            *.F90 )119:                            *.F90 )
120: 120: 
121: file(GLOB NOT_GMIN_SOURCES myblas.f121: file(GLOB NOT_GMIN_SOURCES myblas.f
122:                            mylapack.f122:                            mylapack.f
123:                            gmin_quip_wrapper.f90 
124:                            # These files are generated later123:                            # These files are generated later
125:                            display_version.f90124:                            display_version.f90
126:                            porfuncs.f90 )125:                            porfuncs.f90 )
127: 126: 
128: # Due to a compiler bug in ifort 13.1.3, we can't use -O3 for genrigid.f90127: # Due to a compiler bug in ifort 13.1.3, we can't use -O3 for genrigid.f90
129: # Investigations continue...128: # Investigations continue...
130: if( ${COMPILER_SWITCH} STREQUAL "ifort" )129: if( ${COMPILER_SWITCH} STREQUAL "ifort" )
131:   SET_SOURCE_FILES_PROPERTIES( genrigid.f90 PROPERTIES COMPILE_FLAGS -O2 )130:   SET_SOURCE_FILES_PROPERTIES( genrigid.f90 PROPERTIES COMPILE_FLAGS -O2 )
132: endif ( ${COMPILER_SWITCH} STREQUAL "ifort" )131: endif ( ${COMPILER_SWITCH} STREQUAL "ifort" )
133: 132: 
340:                               cuda_extralib )339:                               cuda_extralib )
341:   set_target_properties(CUDAGMIN PROPERTIES LINKER_LANGUAGE "Fortran")340:   set_target_properties(CUDAGMIN PROPERTIES LINKER_LANGUAGE "Fortran")
342:   set_target_properties(CUDAGMIN PROPERTIES COMPILE_DEFINITIONS "${COMPILE_DEFINITIONS};CUDA")341:   set_target_properties(CUDAGMIN PROPERTIES COMPILE_DEFINITIONS "${COMPILE_DEFINITIONS};CUDA")
343:   target_link_libraries(CUDAGMIN gminlib 342:   target_link_libraries(CUDAGMIN gminlib 
344:                                  CUDAinterface343:                                  CUDAinterface
345:                                  amber12_base344:                                  amber12_base
346:                                  cuda_extralib345:                                  cuda_extralib
347:                                  ${MYLAPACK_LIBS} )346:                                  ${MYLAPACK_LIBS} )
348: endif(WITH_CUDA)347: endif(WITH_CUDA)
349: 348: 
350: # QUIP 
351: option(WITH_QUIP "Enable QUIPGMIN compilation" OFF) 
352: if(WITH_QUIP) 
353:   SET(EXTRA_SOURCES ${ALL_EXTRA_SOURCES} gmin_quip_wrapper.f90) 
354:   list(REMOVE_ITEM EXTRA_SOURCES ${DUMMY_QUIP}) 
355:   add_executable(QUIPGMIN main.F ${EXTRA_SOURCES}) 
356:   set_module_dir(QUIPGMIN) 
357:   set_module_depends(QUIPGMIN gminlib) 
358:   set_target_properties(QUIPGMIN PROPERTIES LINKER_LANGUAGE "Fortran") 
359:   set_target_properties(QUIPGMIN PROPERTIES COMPILE_DEFINITIONS "${COMPILE_DEFINITIONS};${DUMMY_CPP_FLAGS}") 
360:   target_link_libraries(QUIPGMIN gminlib /home/wales/QUIP/build/linux_x86_64_gfortran/libquip.a ${MYLAPACK_LIBS}) 
361: endif(WITH_QUIP) 
362:  
363:  
364: #DMACRYS349: #DMACRYS
365: option(WITH_DMACRYS "Enable DMAGMIN compilation (DMACRYS needs to be present!)" OFF)350: option(WITH_DMACRYS "Enable DMAGMIN compilation (DMACRYS needs to be present!)" OFF)
366: if(WITH_DMACRYS)351: if(WITH_DMACRYS)
367:   SET(EXTRA_SOURCES ${ALL_EXTRA_SOURCES})352:   SET(EXTRA_SOURCES ${ALL_EXTRA_SOURCES})
368:   list(REMOVE_ITEM EXTRA_SOURCES ${DUMMY_DMACRYS})353:   list(REMOVE_ITEM EXTRA_SOURCES ${DUMMY_DMACRYS})
369:   add_subdirectory(DMACRYSinterface)354:   add_subdirectory(DMACRYSinterface)
370:   add_executable(DMAGMIN main.F355:   add_executable(DMAGMIN main.F
371:                          ${EXTRA_SOURCES} )356:                          ${EXTRA_SOURCES} )
372:   set_module_dir(DMAGMIN)357:   set_module_dir(DMAGMIN)
373:   set_module_depends(DMAGMIN gminlib)358:   set_module_depends(DMAGMIN gminlib)


r33258/dbrent.f 2017-09-01 16:30:20.309057364 +0100 r33257/dbrent.f 2017-09-01 16:30:23.369097943 +0100
 18: C 18: C
 19: C 19: C
 20: C Given the function F1DIM, its derivative function DF1DIM 20: C Given the function F1DIM, its derivative function DF1DIM
 21: C and a bracketing triplet XA, XB, XC, this routine 21: C and a bracketing triplet XA, XB, XC, this routine
 22: C isolates the minimum and returns the abcissa of the minimum as XMIN, 22: C isolates the minimum and returns the abcissa of the minimum as XMIN,
 23: C and the minimum function value is returned as DBRENT. 23: C and the minimum function value is returned as DBRENT.
 24: C 24: C
 25:       FUNCTION DBRENT(AX,BX,CX,TOLB,XMIN) 25:       FUNCTION DBRENT(AX,BX,CX,TOLB,XMIN)
 26:       IMPLICIT DOUBLE PRECISION (A-H,P-Z) 26:       IMPLICIT DOUBLE PRECISION (A-H,P-Z)
 27:       DOUBLE PRECISION OLDE 27:       DOUBLE PRECISION OLDE
 28:       INTEGER ITMAX, ITER 
 29:       PARAMETER (ITMAX=100,ZEPS=1.0D-10) 28:       PARAMETER (ITMAX=100,ZEPS=1.0D-10)
 30:       LOGICAL OK1,OK2 29:       LOGICAL OK1,OK2
 31:       A=MIN(AX,CX) 30:       A=MIN(AX,CX)
 32:       B=MAX(AX,CX) 31:       B=MAX(AX,CX)
 33:       V=BX 32:       V=BX
 34:       W=V 33:       W=V
 35:       XX=V 34:       XX=V
 36:       E=0.0D0 35:       E=0.0D0
 37:       CALL ZWISCHEN(XX,DF1DIM,POTEL1) 36:       CALL ZWISCHEN(XX,DF1DIM,POTEL1)
 38:       FX=POTEL1 37:       FX=POTEL1


r33258/enumerate.f90 2017-09-01 16:30:20.533060335 +0100 r33257/enumerate.f90 2017-09-01 16:30:23.605101074 +0100
 22: INTEGER, INTENT(IN) :: NFLOAT, NEWORB, HARDMAXIMUM 22: INTEGER, INTENT(IN) :: NFLOAT, NEWORB, HARDMAXIMUM
 23: INTEGER, INTENT(IN) :: NEWORBSIZE(NEWORB) 23: INTEGER, INTENT(IN) :: NEWORBSIZE(NEWORB)
 24: INTEGER COUNTS(0:NFLOAT) 24: INTEGER COUNTS(0:NFLOAT)
 25: INTEGER J, I, MAXCOUNT, MAXDEGEN, J1, NDUMMY, NOK 25: INTEGER J, I, MAXCOUNT, MAXDEGEN, J1, NDUMMY, NOK
 26: INTEGER, ALLOCATABLE :: OCCUPATIONS(:,:,:), SAVEOCC(:,:,:) 26: INTEGER, ALLOCATABLE :: OCCUPATIONS(:,:,:), SAVEOCC(:,:,:)
 27: INTEGER, INTENT(OUT) :: OCCS(HARDMAXIMUM,NEWORB), NPOSS 27: INTEGER, INTENT(OUT) :: OCCS(HARDMAXIMUM,NEWORB), NPOSS
 28: LOGICAL DEBUG 28: LOGICAL DEBUG
 29:  29: 
 30: MAXDEGEN=MIN(HARDMAXIMUM,100) 30: MAXDEGEN=MIN(HARDMAXIMUM,100)
 31: ! ALLOCATE(OCCUPATIONS(0:NFLOAT,MAXDEGEN,NEWORB)) 31: ! ALLOCATE(OCCUPATIONS(0:NFLOAT,MAXDEGEN,NEWORB))
 32: IF (ALLOCATED(OCCUPATIONS)) DEALLOCATE(OCCUPATIONS) 
 33: ALLOCATE(OCCUPATIONS(0:NFLOAT,HARDMAXIMUM,NEWORB)) 32: ALLOCATE(OCCUPATIONS(0:NFLOAT,HARDMAXIMUM,NEWORB))
 34: COUNTS(0)=1; COUNTS(1:NFLOAT)=0 33: COUNTS(0)=1; COUNTS(1:NFLOAT)=0
 35: MAXCOUNT=0 34: MAXCOUNT=0
 36: OCCUPATIONS(0:NFLOAT,1:MAXDEGEN,1:NEWORB)=0 35: OCCUPATIONS(0:NFLOAT,1:MAXDEGEN,1:NEWORB)=0
 37:  36: 
 38: IF (DEBUG) WRITE(MYUNIT,'(A,3I6)') 'enumerate> NFLOAT, HARDMAXIMUM, NEWORB=',NFLOAT, HARDMAXIMUM, NEWORB 37: IF (DEBUG) WRITE(MYUNIT,'(A,3I6)') 'enumerate> NFLOAT, HARDMAXIMUM, NEWORB=',NFLOAT, HARDMAXIMUM, NEWORB
 39:  38: 
 40: ! 39: !
 41: ! This algorithm is a modification of the Beyer Swinehart direct count procedure for  40: ! This algorithm is a modification of the Beyer Swinehart direct count procedure for 
 42: ! vibrational densities of states, described in Baer and Hase, p. 183. 41: ! vibrational densities of states, described in Baer and Hase, p. 183.


r33258/gmin_quipdummy.f90 2017-09-01 16:30:20.757063306 +0100 r33257/gmin_quipdummy.f90 2017-09-01 16:30:23.833104094 +0100
  1: SUBROUTINE GMIN_QUIP_WRAPPER(COORDS,GRADIENT,ENRG)  1: SUBROUTINE GMIN_QUIP_WRAPPER(COORDS,GRADIENT,ENRG,QATOMTYPE,QARGSTR)
  2:   2: 
  3: IMPLICIT NONE  3: IMPLICIT NONE
  4:   4: 
  5: DOUBLE PRECISION, DIMENSION(*) :: COORDS  5: DOUBLE PRECISION, DIMENSION(*) :: COORDS
  6: DOUBLE PRECISION, DIMENSION(*) :: GRADIENT  6: DOUBLE PRECISION, DIMENSION(*) :: GRADIENT
  7: DOUBLE PRECISION :: ENRG  7: DOUBLE PRECISION :: ENRG
  8: CHARACTER(LEN=10240)  :: QARGSTR  8: CHARACTER(LEN=10240)  :: QARGSTR
  9: CHARACTER(LEN=3) :: QATOMTYPE  9: CHARACTER(LEN=3) :: QATOMTYPE
 10:  10: 
 11: RETURN 11: RETURN


r33258/input.f 2017-09-01 16:30:20.981066276 +0100 r33257/input.f 2017-09-01 16:30:24.057107066 +0100
 96: C      #include file-name 96: C      #include file-name
 97: C         switches input to be from the file specified; 97: C         switches input to be from the file specified;
 98: C      #revert 98: C      #revert
 99: C         (or end-of-file) reverts to the previous file. 99: C         (or end-of-file) reverts to the previous file.
100: C    Also100: C    Also
101: C      #concat "string"101: C      #concat "string"
102: C         sets the concatenation string; e.g.102: C         sets the concatenation string; e.g.
103: C         #concat "\"103: C         #concat "\"
104:       CHARACTER CHAR104:       CHARACTER CHAR
105:       COMMON /BUFFER/ CHAR(800)105:       COMMON /BUFFER/ CHAR(800)
106:       INTEGER IR, LINE106:       INTEGER IR
107:       LOGICAL SKIPBL, CLEAR, ECHO, CAT107:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
108:       INTEGER NITEM, NERROR, NCR, LOC, ITEM, LAST, K, LC 
109:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,108:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,
110:      &                NERROR, ECHO, LAST, CAT109:      &                NERROR, ECHO, LAST, CAT
111: 110: 
112:       LOGICAL BLANK, TCOMMA, END111:       LOGICAL BLANK, TCOMMA, END
113:       CHARACTER(LEN=8) CONCAT112:       CHARACTER(LEN=8) CONCAT
114:       DATA CONCAT /'+++'/, LC /3/113:       DATA CONCAT /'+++'/, LC /3/
115:       SAVE CONCAT, LC114:       SAVE CONCAT, LC
116:  115:  
117: C     ITEM    is the number of the last item read from the buffer116: C     ITEM    is the number of the last item read from the buffer
118: C     NITEM   is the number of items in the buffer117: C     NITEM   is the number of items in the buffer
155: C  appended to the current line, overwriting the concatenation string.154: C  appended to the current line, overwriting the concatenation string.
156: C  This procedure is repeated if necessary until a line is found that does155: C  This procedure is repeated if necessary until a line is found that does
157: C  not end with the concatenation string.156: C  not end with the concatenation string.
158:  157:  
159: C  The concatenation string may be modified by changing the DATA statement158: C  The concatenation string may be modified by changing the DATA statement
160: C  above. The integer LC must be set to the number of non-blank characters159: C  above. The integer LC must be set to the number of non-blank characters
161: C  in the concatenation string. If it is set to zero, no concatenation160: C  in the concatenation string. If it is set to zero, no concatenation
162: C  occurs. The concatenation string may also be changed by the #concat161: C  occurs. The concatenation string may also be changed by the #concat
163: C  directive in the data file.162: C  directive in the data file.
164:  163:  
165:       INTEGER LEVEL, I, IR0, L, M, NEST164:       INTEGER LEVEL
166:       SAVE LEVEL, IR0165:       SAVE LEVEL, IR0
167:       CHARACTER(LEN=80) W, F166:       CHARACTER(LEN=80) W, F
168: 167: 
169:       CHARACTER SPACE, BRA, KET, COMMA, SQUOTE, DQUOTE, TERM168:       CHARACTER SPACE, BRA, KET, COMMA, SQUOTE, DQUOTE, TERM
170:       DATA LEVEL /0/169:       DATA LEVEL /0/
171:       DATA SPACE /' '/, BRA /'('/, KET /')'/, COMMA /','/,170:       DATA SPACE /' '/, BRA /'('/, KET /')'/, COMMA /','/,
172:      *    SQUOTE /''''/, DQUOTE /'"'/171:      *    SQUOTE /''''/, DQUOTE /'"'/
173: C }}}172: C }}}
174: 173: 
175: C {{{ 174: C {{{ 
339: C }}} 338: C }}} 
340:       END339:       END
341:  340:  
342: C-----------------------------------------------------------------------341: C-----------------------------------------------------------------------
343: C> \name BLOCK DATA INBLK 342: C> \name BLOCK DATA INBLK 
344:       BLOCK DATA INBLK343:       BLOCK DATA INBLK
345: 344: 
346:       CHARACTER CHAR345:       CHARACTER CHAR
347:       COMMON /BUFFER/ CHAR(800)346:       COMMON /BUFFER/ CHAR(800)
348:       LOGICAL SKIPBL, CLEAR, ECHO, CAT347:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
349:       INTEGER NITEM, NERROR, NCR, LOC, LINE, ITEM, LAST, K 
350:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,348:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,
351:      &                NERROR, ECHO, LAST, CAT349:      &                NERROR, ECHO, LAST, CAT
352: 350: 
353:       DATA ITEM /0/, NITEM /0/, CHAR /800*' '/, LOC /80*0/, LINE /0/351:       DATA ITEM /0/, NITEM /0/, CHAR /800*' '/, LOC /80*0/, LINE /0/
354:       DATA SKIPBL /.FALSE./, CLEAR /.TRUE./, NCR /0/, NERROR /0/352:       DATA SKIPBL /.FALSE./, CLEAR /.TRUE./, NCR /0/, NERROR /0/
355:       DATA ECHO /.FALSE./353:       DATA ECHO /.FALSE./
356:       END354:       END
357:  355:  
358: C-----------------------------------------------------------------------356: C-----------------------------------------------------------------------
359:  357:  
376: C> \brief Read the next item from the buffer as a real number374: C> \brief Read the next item from the buffer as a real number
377: C> \param A (DP)375: C> \param A (DP)
378: C>376: C>
379: C Declarations {{{ 377: C Declarations {{{ 
380:       INTEGER P, STATE378:       INTEGER P, STATE
381:       LOGICAL NULL, XNULL379:       LOGICAL NULL, XNULL
382:       DOUBLE PRECISION A, AD, B, TEN, SIGN380:       DOUBLE PRECISION A, AD, B, TEN, SIGN
383:       CHARACTER CHAR381:       CHARACTER CHAR
384:       COMMON /BUFFER/ CHAR(800)382:       COMMON /BUFFER/ CHAR(800)
385:       LOGICAL SKIPBL, CLEAR, ECHO, CAT383:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
386:       INTEGER NITEM, NERROR, NCR, LOC, LINE, ITEM, LAST, K, KXSIGN, KXIMP, KX, I2, I1, NITEMS, I 
387:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,384:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,
388:      &                NERROR, ECHO, LAST, CAT385:      &                NERROR, ECHO, LAST, CAT
389: 386: 
390:       CHARACTER C, PLUS, MINUS, DOT, SPACE, STAR, D, E, COMMA,387:       CHARACTER C, PLUS, MINUS, DOT, SPACE, STAR, D, E, COMMA,
391:      &    S1, S2, DIGIT(10)388:      &    S1, S2, DIGIT(10)
392:       DATA DIGIT /'1', '2', '3', '4', '5', '6', '7', '8', '9', '0'/389:       DATA DIGIT /'1', '2', '3', '4', '5', '6', '7', '8', '9', '0'/
393:       DATA PLUS /'+'/, MINUS /'-'/, DOT /'.'/, SPACE /' '/, STAR /'*'/,390:       DATA PLUS /'+'/, MINUS /'-'/, DOT /'.'/, SPACE /' '/, STAR /'*'/,
394:      *    D /'D'/, E /'E'/, COMMA /','/391:      *    D /'D'/, E /'E'/, COMMA /','/
395:       DATA TEN /10D0/392:       DATA TEN /10D0/
396: C }}}393: C }}}
505:       KX=KX*KXSIGN+KXIMP502:       KX=KX*KXSIGN+KXIMP
506:       A=SIGN*B*(TEN**KX)503:       A=SIGN*B*(TEN**KX)
507:  504:  
508: 110   RETURN505: 110   RETURN
509: C }}} 506: C }}} 
510:       END507:       END
511:  508:  
512: C-----------------------------------------------------------------------509: C-----------------------------------------------------------------------
513:  510:  
514:       SUBROUTINE INPUTI(I)511:       SUBROUTINE INPUTI(I)
515:       INTEGER I 
516:       DOUBLE PRECISION A512:       DOUBLE PRECISION A
517:       A=I513:       A=I
518:       CALL READF(A)514:       CALL READF(A)
519:       I=A515:       I=A
520:       RETURN516:       RETURN
521:       END517:       END
522:  518:  
523: C-----------------------------------------------------------------------519: C-----------------------------------------------------------------------
524:  520:  
525: C Doxygen comments {{{ 521: C Doxygen comments {{{ 
587: C  ENCODE, which produces the DATA statements required to initialize583: C  ENCODE, which produces the DATA statements required to initialize
588: C  the array.584: C  the array.
589: C }}}585: C }}}
590:  586:  
591: C Declarations {{{ 587: C Declarations {{{ 
592:       INTEGER M(*), N(*), TP, P588:       INTEGER M(*), N(*), TP, P
593:       CHARACTER C(*), SPACE589:       CHARACTER C(*), SPACE
594:       CHARACTER CHAR590:       CHARACTER CHAR
595:       COMMON /BUFFER/ CHAR(800)591:       COMMON /BUFFER/ CHAR(800)
596:       LOGICAL SKIPBL, CLEAR, ECHO, CAT592:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
597:       INTEGER NITEM, NERROR, NCR, LOC, LINE, ITEM, LAST, K 
598:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,593:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,
599:      &                NERROR, ECHO, LAST, CAT594:      &                NERROR, ECHO, LAST, CAT
600:       DATA SPACE /' '/595:       DATA SPACE /' '/
601: C }}} 596: C }}} 
602: 597: 
603: C Subroutine body {{{598: C Subroutine body {{{
604:       K=-1599:       K=-1
605:       IF (ITEM .GE. NITEM) RETURN600:       IF (ITEM .GE. NITEM) RETURN
606:       ITEM=ITEM+1601:       ITEM=ITEM+1
607:       NCR=0602:       NCR=0
733:  728:  
734:       SUBROUTINE READCH(M)729:       SUBROUTINE READCH(M)
735:  730:  
736: C  Read a single character from the next (or the current) data item.731: C  Read a single character from the next (or the current) data item.
737: C  No account is taken of special characters.732: C  No account is taken of special characters.
738: 733: 
739: C Declarations {{{ 734: C Declarations {{{ 
740:       CHARACTER CHAR735:       CHARACTER CHAR
741:       COMMON /BUFFER/ CHAR(800)736:       COMMON /BUFFER/ CHAR(800)
742:       LOGICAL SKIPBL, CLEAR, ECHO, CAT737:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
743:       INTEGER I, K, NCR, NERROR, ITEM, NITEM, LOC, LAST, L, LINE 
744:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,738:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,
745:      &                NERROR, ECHO, LAST, CAT739:      &                NERROR, ECHO, LAST, CAT
746:       CHARACTER*(*) M740:       CHARACTER*(*) M
747: C }}} 741: C }}} 
748:       M=' '742:       M=' '
749:       IF (ITEM .GE. NITEM .AND. NCR .EQ. 0) RETURN743:       IF (ITEM .GE. NITEM .AND. NCR .EQ. 0) RETURN
750:       IF (NCR .EQ. 0) ITEM=ITEM+1744:       IF (NCR .EQ. 0) ITEM=ITEM+1
751:       L=LOC(ITEM)745:       L=LOC(ITEM)
752:       M=CHAR(L+NCR)746:       M=CHAR(L+NCR)
753:       NCR=NCR+1747:       NCR=NCR+1
854:       CALL READF(A)848:       CALL READF(A)
855:       S=A849:       S=A
856:       RETURN850:       RETURN
857:       END851:       END
858:  852:  
859: C-----------------------------------------------------------------------853: C-----------------------------------------------------------------------
860:  854:  
861:       SUBROUTINE READI(I)855:       SUBROUTINE READI(I)
862: C> \name READI856: C> \name READI
863: C> \brief Read an integer from the current record857: C> \brief Read an integer from the current record
864:       INTEGER I 
865:       DOUBLE PRECISION A858:       DOUBLE PRECISION A
866:       A=I859:       A=I
867:       CALL READF(A)860:       CALL READF(A)
868:       I=A861:       I=A
869:       RETURN862:       RETURN
870:       END863:       END
871:  864:  
872: C-----------------------------------------------------------------------865: C-----------------------------------------------------------------------
873:  866:  
874:       SUBROUTINE REREAD(K)867:       SUBROUTINE REREAD(K)
875: C> \name REREAD 868: C> \name REREAD 
876: C>869: C>
877: C>  K>0  Reread from item K870: C>  K>0  Reread from item K
878: C>  K<0  Go back |K| items871: C>  K<0  Go back |K| items
879: C>  K=0  Same as K=-1, i.e. reread last item.872: C>  K=0  Same as K=-1, i.e. reread last item.
880:  873:  
881:       CHARACTER CHAR874:       CHARACTER CHAR
882:       COMMON /BUFFER/ CHAR(800)875:       COMMON /BUFFER/ CHAR(800)
883:       LOGICAL SKIPBL, CLEAR, ECHO, CAT876:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
884:       INTEGER NITEM, NERROR, NCR, LOC, LINE, ITEM, LAST, K 
885:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,877:       COMMON /BUFINF/ ITEM, NITEM, LOC(80), LINE, SKIPBL, CLEAR, NCR,
886:      &                NERROR, ECHO, LAST, CAT878:      &                NERROR, ECHO, LAST, CAT
887:  879:  
888:       IF (K .LT. 0) ITEM=ITEM+K880:       IF (K .LT. 0) ITEM=ITEM+K
889:       IF (K .EQ. 0) ITEM=ITEM-1881:       IF (K .EQ. 0) ITEM=ITEM-1
890:       IF (K .GT. 0) ITEM=K-1882:       IF (K .GT. 0) ITEM=K-1
891:       IF (ITEM .LT. 0) ITEM=0883:       IF (ITEM .LT. 0) ITEM=0
892:       NCR=0884:       NCR=0
893:       RETURN885:       RETURN
894:       END886:       END
895:  887:  
896: C-----------------------------------------------------------------------888: C-----------------------------------------------------------------------
897:  889:  
898:       SUBROUTINE MYUPCASE(WORD)890:       SUBROUTINE MYUPCASE(WORD)
899:       CHARACTER WORD*(*)891:       CHARACTER WORD*(*)
900:  892:  
901:       INTEGER K, I 
902:       CHARACTER UC*26, LC*26893:       CHARACTER UC*26, LC*26
903:       DATA UC /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/894:       DATA UC /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
904:       DATA LC /'abcdefghijklmnopqrstuvwxyz'/895:       DATA LC /'abcdefghijklmnopqrstuvwxyz'/
905:  896:  
906:       DO 10 I=1,LEN(WORD)897:       DO 10 I=1,LEN(WORD)
907:       K=INDEX(LC,WORD(I:I))898:       K=INDEX(LC,WORD(I:I))
908:       IF (K .NE. 0) WORD(I:I)=UC(K:K)899:       IF (K .NE. 0) WORD(I:I)=UC(K:K)
909: 10    CONTINUE900: 10    CONTINUE
910:       RETURN901:       RETURN
911:  902:  
921: C  REPORT  B1  ( 16:10:41 Thursday 30 April 1992 )912: C  REPORT  B1  ( 16:10:41 Thursday 30 April 1992 )
922: 913: 
923:       SUBROUTINE REPORT(C,REFLCT)914:       SUBROUTINE REPORT(C,REFLCT)
924: C Declarations {{{915: C Declarations {{{
925:       CHARACTER C*(*)916:       CHARACTER C*(*)
926:       LOGICAL REFLCT917:       LOGICAL REFLCT
927: 918: 
928:       CHARACTER BUFF919:       CHARACTER BUFF
929:       COMMON /BUFFER/ BUFF(800)920:       COMMON /BUFFER/ BUFF(800)
930:       LOGICAL SKIPBL, CLEAR, ECHO, CAT921:       LOGICAL SKIPBL, CLEAR, ECHO, CAT
931:       INTEGER K, NCR, NERROR, ITEM, NITEM, LOC, LAST, L, LINE, NITEMS, I1, I2, I, NEST 
932:       COMMON /BUFINF/ ITEM, NITEMS, LOC(80), LINE, SKIPBL, CLEAR, NCR,922:       COMMON /BUFINF/ ITEM, NITEMS, LOC(80), LINE, SKIPBL, CLEAR, NCR,
933:      &                NERROR, ECHO, LAST, CAT923:      &                NERROR, ECHO, LAST, CAT
934: 924: 
935:       INTEGER PRINT925:       INTEGER PRINT
936:       LOGICAL SWITCH, ONLINE926:       LOGICAL SWITCH, ONLINE
937:       COMMON /TEST/ SWITCH(8), PRINT927:       COMMON /TEST/ SWITCH(8), PRINT
938:       EQUIVALENCE (ONLINE, SWITCH(4))928:       EQUIVALENCE (ONLINE, SWITCH(4))
939: 929: 
940:       CHARACTER(LEN=3) S1, S2930:       CHARACTER(LEN=3) S1, S2
941: C  }}}931: C  }}}


r33258/main.F 2017-09-01 16:30:21.197069139 +0100 r33257/main.F 2017-09-01 16:30:24.285110090 +0100
 35:       USE MULTIPOT, only: MULTIPOT_INITIALISE 35:       USE MULTIPOT, only: MULTIPOT_INITIALISE
 36:       USE GAUSS_MOD, ONLY: KEGEN 36:       USE GAUSS_MOD, ONLY: KEGEN
 37:       USE MOLECULAR_DYNAMICS, ONLY : MDT, MD_NSTEPS, MD_NWAIT, MDRUN 37:       USE MOLECULAR_DYNAMICS, ONLY : MDT, MD_NSTEPS, MD_NWAIT, MDRUN
 38:  38: 
 39:       IMPLICIT NONE 39:       IMPLICIT NONE
 40:       !EXTERNAL READ_CMD_ARGS 40:       !EXTERNAL READ_CMD_ARGS
 41: #ifdef MPI 41: #ifdef MPI
 42:       INCLUDE 'mpif.h' 42:       INCLUDE 'mpif.h'
 43: #endif 43: #endif
 44:       INTEGER J1,J2, JP, MPIERR, NDUMMY3,NPTOTAL,VERSIONTEMP,GETUNIT,LUNIT 44:       INTEGER J1,J2, JP, MPIERR, NDUMMY3,NPTOTAL,VERSIONTEMP,GETUNIT,LUNIT
  45:       DOUBLE PRECISION, ALLOCATABLE :: SCREENC(:)
 45:       DOUBLE PRECISION POTEL, DUMMY, INTFREEZETOLSAVE, RMAT(3,3), DUMMY2, DIST2, LINTCONSTRAINTTOL 46:       DOUBLE PRECISION POTEL, DUMMY, INTFREEZETOLSAVE, RMAT(3,3), DUMMY2, DIST2, LINTCONSTRAINTTOL
 46:       DOUBLE PRECISION, ALLOCATABLE :: TMPCOORDS(:), ENDCOORDS(:,:) 47:       DOUBLE PRECISION, ALLOCATABLE :: TMPCOORDS(:), ENDCOORDS(:,:)
 47:       INTEGER, ALLOCATABLE :: NDUMMY(:), NDUMMY2(:,:) 48:       INTEGER, ALLOCATABLE :: NDUMMY(:), NDUMMY2(:,:)
 48:       LOGICAL LOPEN, YESNO  49:       LOGICAL LOPEN, YESNO 
 49:       INTEGER J6, EPOCH 50:       INTEGER J6, EPOCH
 50:  51: 
 51:       CHARACTER(LEN=130) ISTR,JSTR 52:       CHARACTER(LEN=130) ISTR,JSTR
 52:       CHARACTER(LEN=40) :: atom1,atom2,atompair 53:       CHARACTER(LEN=40) :: atom1,atom2,atompair
 53:  54: 
 54:       CHARACTER(LEN=13) :: CUDAFILENAME1 55:       CHARACTER(LEN=13) :: CUDAFILENAME1
164: 165: 
165: ! vr274> DMACRYS is used166: ! vr274> DMACRYS is used
166:       DMACRYST = .false.167:       DMACRYST = .false.
167:       DMACRYS_RANDOMSTART=.false.168:       DMACRYS_RANDOMSTART=.false.
168:       DMACRYS_EXPAND = 1.0D0169:       DMACRYS_EXPAND = 1.0D0
169:       DMACRYS_LATTICE_STEP = 0.0D0170:       DMACRYS_LATTICE_STEP = 0.0D0
170: ! END DMACRYS things171: ! END DMACRYS things
171:  172:  
172:       ALLOCATE(FIN(3*NATOMSALLOC))173:       ALLOCATE(FIN(3*NATOMSALLOC))
173:       ALLOCATE(XICOM(3*NATOMSALLOC),PCOM(3*NATOMSALLOC))174:       ALLOCATE(XICOM(3*NATOMSALLOC),PCOM(3*NATOMSALLOC))
 175:       ALLOCATE(SCREENC(3*NATOMSALLOC))
174:       ALLOCATE(IATNUM(NATOMSALLOC), VT(NATOMSALLOC), ZSYM(NATOMSALLOC))176:       ALLOCATE(IATNUM(NATOMSALLOC), VT(NATOMSALLOC), ZSYM(NATOMSALLOC))
175:       VT(1:NATOMSALLOC)=0.0D0 ! TO PREVENT READING FROM UNINITIALISED MEMORY177:       VT(1:NATOMSALLOC)=0.0D0 ! TO PREVENT READING FROM UNINITIALISED MEMORY
176:       IF (CALCQT) CALL SHINIT178:       IF (CALCQT) CALL SHINIT
177: 179: 
178:       ALLOCATE(FINISH(3*NATOMSALLOC))180:       ALLOCATE(FINISH(3*NATOMSALLOC))
179: 181: 
180:       INQUIRE(UNIT=1,OPENED=LOPEN)182:       INQUIRE(UNIT=1,OPENED=LOPEN)
181:       IF (LOPEN) THEN183:       IF (LOPEN) THEN
182:          WRITE(*,'(A,I2,A)') 'main> A ERROR *** Unit ', 1, ' is not free '184:          WRITE(*,'(A,I2,A)') 'main> A ERROR *** Unit ', 1, ' is not free '
183:          STOP185:          STOP
630:       CALL RUN_TESTS_AFTER_INIT()632:       CALL RUN_TESTS_AFTER_INIT()
631: 633: 
632:       IF (GENALT) THEN ! mo361> Run GA634:       IF (GENALT) THEN ! mo361> Run GA
633:          !NRUNS=0635:          !NRUNS=0
634:          CALL MYGA_RUN()636:          CALL MYGA_RUN()
635:       ELSEIF (MULTIPERMT) THEN  ! ds656> Span label permutations637:       ELSEIF (MULTIPERMT) THEN  ! ds656> Span label permutations
636:          CALL MULTIPERM()638:          CALL MULTIPERM()
637:       ELSEIF (MDT) THEN          ! ds656> Molecular Dynamics639:       ELSEIF (MDT) THEN          ! ds656> Molecular Dynamics
638:          CALL MDRUN(COORDS,MD_NSTEPS,TEMP(1),.TRUE.)640:          CALL MDRUN(COORDS,MD_NSTEPS,TEMP(1),.TRUE.)
639:       ELSEIF ((NRUNS.GT.0).OR.PTMC.OR.BSPT) THEN641:       ELSEIF ((NRUNS.GT.0).OR.PTMC.OR.BSPT) THEN
640:          CALL MCRUNS642:          CALL MCRUNS(SCREENC)
641:       ENDIF643:       ENDIF
642: C     CALL SYSTEM('rm ssdump ssave >& /dev/null')644: C     CALL SYSTEM('rm ssdump ssave >& /dev/null')
643: 645: 
644:       IF (ALLOCATED(FIN)) DEALLOCATE(FIN)646:       IF (ALLOCATED(FIN)) DEALLOCATE(FIN)
645:       IF (ALLOCATED(XICOM)) DEALLOCATE(XICOM)647:       IF (ALLOCATED(XICOM)) DEALLOCATE(XICOM)
646:       IF (ALLOCATED(PCOM)) DEALLOCATE(PCOM)648:       IF (ALLOCATED(PCOM)) DEALLOCATE(PCOM)
647:       IF (ALLOCATED(GAUSSKK)) DEALLOCATE(GAUSSKK,GAUSSEE)649:       IF (ALLOCATED(GAUSSKK)) DEALLOCATE(GAUSSKK,GAUSSEE)
648: C     deallocate dynamic memory for AMBER650: C     deallocate dynamic memory for AMBER
649:       IF (AMBERT) CALL AMBER_DEALLOCATE_STACKS651:       IF (AMBERT) CALL AMBER_DEALLOCATE_STACKS
650:       IF (ALLOCATED(ANV)) DEALLOCATE(ANV)      652:       IF (ALLOCATED(ANV)) DEALLOCATE(ANV)      
667:          CLOSE(MYEUNIT)669:          CLOSE(MYEUNIT)
668:          CLOSE(MYMUNIT)670:          CLOSE(MYMUNIT)
669:          IF (RMST) CLOSE(MYRUNIT)671:          IF (RMST) CLOSE(MYRUNIT)
670:          CLOSE(MYBUNIT)672:          CLOSE(MYBUNIT)
671:          IF (A9INTET) THEN673:          IF (A9INTET) THEN
672:             CLOSE(3998)674:             CLOSE(3998)
673:             CLOSE(3999)675:             CLOSE(3999)
674:          ENDIF676:          ENDIF
675:       ENDIF677:       ENDIF
676: 678: 
 679:       DEALLOCATE(SCREENC)
677:       DEALLOCATE(IATNUM, VT, ZSYM)680:       DEALLOCATE(IATNUM, VT, ZSYM)
678:       DEALLOCATE(FF,QMIN)681:       DEALLOCATE(FF,QMIN)
679:       DEALLOCATE(QMINP,QMINT,QMINNATOMS)682:       DEALLOCATE(QMINP,QMINT,QMINNATOMS)
680:       if (boxderivt) deallocate(boxq)683:       if (boxderivt) deallocate(boxq)
681:       DEALLOCATE(ESAVE,XINSAVE)684:       DEALLOCATE(ESAVE,XINSAVE)
682:       DEALLOCATE(VEC)685:       DEALLOCATE(VEC)
683:       DEALLOCATE(FIXSTEP,FIXTEMP,FIXBOTH,TEMP,ACCRAT,STEP,ASTEP,OSTEP,BLOCK,NT,NQ,EPREV,686:       DEALLOCATE(FIXSTEP,FIXTEMP,FIXBOTH,TEMP,ACCRAT,STEP,ASTEP,OSTEP,BLOCK,NT,NQ,EPREV,
684:      &           JUMPMOVE,JUMPINT,JDUMP,COORDS,COORDSO,VAT,VATO,687:      &           JUMPMOVE,JUMPINT,JDUMP,COORDS,COORDSO,VAT,VATO,
685:      &         JUMPTO,SHELLMOVES,PTGROUP,NSURFMOVES,NCORE)688:      &         JUMPTO,SHELLMOVES,PTGROUP,NSURFMOVES,NCORE)
686:       DEALLOCATE(FROZEN)689:       DEALLOCATE(FROZEN)


r33258/mc.F 2017-09-01 16:30:21.429072216 +0100 r33257/mc.F 2017-09-01 16:30:24.517113165 +0100
  9: !  9: !
 10: !   GMIN is distributed in the hope that it will be useful, 10: !   GMIN is distributed in the hope that it will be useful,
 11: !   but WITHOUT ANY WARRANTY; without even the implied warranty of 11: !   but WITHOUT ANY WARRANTY; without even the implied warranty of
 12: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 12: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 13: !   GNU General Public License for more details. 13: !   GNU General Public License for more details.
 14: ! 14: !
 15: !   You should have received a copy of the GNU General Public License 15: !   You should have received a copy of the GNU General Public License
 16: !   along with this program; if not, write to the Free Software 16: !   along with this program; if not, write to the Free Software
 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 18: ! 18: !
 19:       SUBROUTINE MC(NSTEPS,SCALEFAC) 19:       SUBROUTINE MC(NSTEPS,SCALEFAC,SCREENC)
 20:       USE COMMONS 20:       USE COMMONS
 21:       use genrigid 21:       use genrigid
 22:       USE HINGE_MOVES 22:       USE HINGE_MOVES
 23:       use moves 23:       use moves
 24:       use grouprotmod 24:       use grouprotmod
 25:       use mbpolmod, only: mbpolstep 25:       use mbpolmod, only: mbpolstep
 26:  26: 
 27:       USE QMODULE , ONLY : QMIN, QMINP, INTEQMIN 27:       USE QMODULE , ONLY : QMIN, QMINP, INTEQMIN
 28:       USE modcharmm 28:       USE modcharmm
 29:       USE MODAMBER9, ONLY : MDSTEPT,CISARRAY1,CHIARRAY1,NOCISTRANSDNA,NOCISTRANSRNA, 29:       USE MODAMBER9, ONLY : MDSTEPT,CISARRAY1,CHIARRAY1,NOCISTRANSDNA,NOCISTRANSRNA,


r33258/mcruns.f90 2017-09-01 16:30:21.653075188 +0100 r33257/mcruns.f90 2017-09-01 16:30:24.737116083 +0100
  9: !  9: !
 10: !   GMIN is distributed in the hope that it will be useful, 10: !   GMIN is distributed in the hope that it will be useful,
 11: !   but WITHOUT ANY WARRANTY; without even the implied warranty of 11: !   but WITHOUT ANY WARRANTY; without even the implied warranty of
 12: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 12: !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 13: !   GNU General Public License for more details. 13: !   GNU General Public License for more details.
 14: ! 14: !
 15: !   You should have received a copy of the GNU General Public License 15: !   You should have received a copy of the GNU General Public License
 16: !   along with this program; if not, write to the Free Software 16: !   along with this program; if not, write to the Free Software
 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA 17: !   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 18: ! 18: !
 19: SUBROUTINE MCRUNS 19: SUBROUTINE MCRUNS(SCREENC)
 20:    USE COMMONS, ONLY: NATOMS, PTMC, BSPT, ONE_ATOM_TAKESTEP, CHECKDT, COORDS, & 20:    USE COMMONS, ONLY: NATOMS, PTMC, BSPT, ONE_ATOM_TAKESTEP, CHECKDT, COORDS, &
 21:                       NRUNS, MCSTEPS, TFAC, RELAXFQ, NSAVE, GBHT, AMBERMUTATIONT, & 21:                       NRUNS, MCSTEPS, TFAC, RELAXFQ, NSAVE, GBHT, AMBERMUTATIONT, &
 22:                       NMUTATION 22:                       NMUTATION
 23:    USE GENRIGID, ONLY: RIGIDINIT 23:    USE GENRIGID, ONLY: RIGIDINIT
 24:    USE QMODULE, ONLY: QMINP 24:    USE QMODULE, ONLY: QMINP
 25:    USE PREC, ONLY: INT32, REAL64 25:    USE PREC, ONLY: INT32, REAL64
 26:    USE AMBER12_MUTATIONS, ONLY: AMBERMUT_CURR_LOWEST,FINISH_AMBERMUT 26:    USE AMBER12_MUTATIONS, ONLY: AMBERMUT_CURR_LOWEST,FINISH_AMBERMUT
 27:    USE AMBER12_INTERFACE_MOD, ONLY: AMBER12_FINISH 27:    USE AMBER12_INTERFACE_MOD, ONLY: AMBER12_FINISH
 28:    IMPLICIT NONE 28:    IMPLICIT NONE
  29: ! Arguments (what intent for SCREENC?)
  30:    REAL(REAL64)               :: SCREENC(3*NATOMS)
 29: ! Variables 31: ! Variables
 30:    LOGICAL                    :: LOPEN 32:    LOGICAL                    :: LOPEN
 31:    REAL(REAL64), ALLOCATABLE  :: QMINPTMP(:, :) 33:    REAL(REAL64), ALLOCATABLE  :: QMINPTMP(:, :)
 32:    INTEGER(INT32)             :: I 34:    INTEGER(INT32)             :: I
 33:  35: 
 34:    IF (PTMC .OR. BSPT) THEN 36:    IF (PTMC .OR. BSPT) THEN
 35:       IF (ONE_ATOM_TAKESTEP) THEN 37:       IF (ONE_ATOM_TAKESTEP) THEN
 36:          CALL PTMC_ONE_ATOM() 38:          CALL PTMC_ONE_ATOM()
 37:       ELSE 39:       ELSE
 38:          CALL PTBASINSAMPLING() 40:          CALL PTBASINSAMPLING()
 62: ! jwrm2> If checking derivatives, call CHECKD, which then exits 64: ! jwrm2> If checking derivatives, call CHECKD, which then exits
 63:    IF (CHECKDT) THEN 65:    IF (CHECKDT) THEN
 64:       CALL CHECKD(COORDS(:, :)) 66:       CALL CHECKD(COORDS(:, :))
 65:    END IF 67:    END IF
 66:  68: 
 67: ! 69: !
 68: !  NRUNS > 1 is an obsolete option! DJW 70: !  NRUNS > 1 is an obsolete option! DJW
 69: ! 71: !
 70:  72: 
 71:    DO I = 1, NRUNS 73:    DO I = 1, NRUNS
 72:       CALL MC(MCSTEPS(I), TFAC(I)) 74:       CALL MC(MCSTEPS(I), TFAC(I), SCREENC(:))
 73:    END DO 75:    END DO
 74:  76: 
 75: !     DO J1=1,NPAR 77: !     DO J1=1,NPAR
 76: !        CLOSE(DUMPVUNIT(J1)) 78: !        CLOSE(DUMPVUNIT(J1))
 77: !        CLOSE(DUMPXYZUNIT(J1)) 79: !        CLOSE(DUMPXYZUNIT(J1))
 78: !     ENDDO 80: !     ENDDO
 79: !     DUMPT=.FALSE. 81: !     DUMPT=.FALSE.
 80:  82: 
 81:    IF (AMBERMUTATIONT) THEN 83:    IF (AMBERMUTATIONT) THEN
 82:       CALL FINISH_AMBERMUT() 84:       CALL FINISH_AMBERMUT()


r33258/mylbfgs.f90 2017-09-01 16:30:21.873078105 +0100 r33257/mylbfgs.f90 2017-09-01 16:30:24.969119159 +0100
  1: ! This subroutine is to select whether we are to minimise in rigid body/atom coordinates  1: ! This subroutine is to select whether we are to minimise in rigid body/atom coordinates
  2: ! ATOMRIGIDCOORDT is the toggling logical variable  2: ! ATOMRIGIDCOORDT is the toggling logical variable
  3: SUBROUTINE MYLBFGS(N, M, XCOORDS, DIAGCO, EPS, MFLAG, ENERGY, ITMAX, ITDONE, RESET, NP)  3: SUBROUTINE MYLBFGS(N, M, XCOORDS, DIAGCO, EPS, MFLAG, ENERGY, ITMAX, ITDONE, RESET, NP)
  4:    USE COMMONS, ONLY: NATOMS, DMACRYST, HYBRIDMINT, CUDAT, AMBER12T, EPSRIGID, &  4:    USE COMMONS, ONLY: NATOMS, DMACRYST, HYBRIDMINT, CUDAT, AMBER12T, EPSRIGID, &
  5:                       DEBUG, MYUNIT, GRADPROBLEMT, RMS, QCIPOTT  5:                       DEBUG, MYUNIT, GRADPROBLEMT, RMS, QCIPOTT
  6:    USE GENRIGID, ONLY: DEGFREEDOMS, RIGIDINIT, ATOMRIGIDCOORDT, TRANSFORMCTORIGID, &  6:    USE GENRIGID, ONLY: DEGFREEDOMS, RIGIDINIT, ATOMRIGIDCOORDT, TRANSFORMCTORIGID, &
  7:                        TRANSFORMRIGIDTOC, NRIGIDBODY  7:                        TRANSFORMRIGIDTOC, NRIGIDBODY
  8:    USE MODCUDALBFGS, ONLY: CUDA_LBFGS_WRAPPER  8:    USE MODCUDALBFGS, ONLY: CUDA_LBFGS_WRAPPER
  9: !  USE PREC, ONLY: INT32, REAL64  9:    USE PREC, ONLY: INT32, REAL64
 10:    USE RAD_MOD, ONLY: RADCOM 10:    USE RAD_MOD, ONLY: RADCOM
 11:    IMPLICIT NONE 11:    IMPLICIT NONE
 12: ! Arguments 12: ! Arguments
 13: ! jk669 3/3/17 Intents added. 13: ! jk669 3/3/17 Intents added.
 14:    INTEGER, intent(in) :: N 14:    INTEGER(INT32), intent(in) :: N
 15:    INTEGER, intent(in) :: M 15:    INTEGER(INT32), intent(in) :: M
 16:    DOUBLE PRECISION,intent(inout) :: XCOORDS(3*NATOMS) 16:    REAL(REAL64),intent(inout) :: XCOORDS(3*NATOMS)
 17:    LOGICAL, intent(in) :: DIAGCO 17:    LOGICAL, intent(in) :: DIAGCO
 18:    DOUBLE PRECISION, intent(in) :: EPS 18:    REAL(REAL64), intent(in) :: EPS
 19:    LOGICAL, intent(inout) :: MFLAG 19:    LOGICAL, intent(inout) :: MFLAG
 20:    DOUBLE PRECISION, intent(inout) :: ENERGY 20:    REAL(REAL64), intent(inout) :: ENERGY
 21:    INTEGER, intent(in) :: ITMAX 21:    INTEGER(INT32), intent(in) :: ITMAX
 22:    INTEGER, intent(inout) :: ITDONE 22:    INTEGER(INT32), intent(inout) :: ITDONE
 23:    LOGICAL, intent(inout) :: RESET 23:    LOGICAL, intent(inout) :: RESET
 24:    INTEGER, intent(in) :: NP 24:    INTEGER(INT32), intent(in) :: NP
 25: ! Variables 25: ! Variables
 26:    LOGICAL           :: EVAP, EVAPREJECT 26:    LOGICAL           :: EVAP, EVAPREJECT
 27: ! Common block 27: ! Common block
 28: ! TODO: delete common block 28: ! TODO: delete common block
 29: ! ds656> EVAPREJECT was missing here until 10/06/2015 29: ! ds656> EVAPREJECT was missing here until 10/06/2015
 30:    COMMON /EV/ EVAP, EVAPREJECT 30:    COMMON /EV/ EVAP, EVAPREJECT
 31: !   INTEGER           :: TEMPNATOMS, TEMPN !Commented out to match commented out code. jk669 3/3/17 31: !   INTEGER           :: TEMPNATOMS, TEMPN !Commented out to match commented out code. jk669 3/3/17
 32:    DOUBLE PRECISION      :: XRIGIDCOORDS(DEGFREEDOMS) 32:    REAL(REAL64)      :: XRIGIDCOORDS(DEGFREEDOMS)
 33:    DOUBLE PRECISION      :: EPS_TEMP 33:    REAL(REAL64)      :: EPS_TEMP
 34:  34: 
 35: ! vr274> DMACRYS uses a different minimization protocol to avoid cold fusions 35: ! vr274> DMACRYS uses a different minimization protocol to avoid cold fusions
 36:    IF (DMACRYST) THEN 36:    IF (DMACRYST) THEN
 37:       CALL DMACRYS_MINIMIZE(N, M, XCOORDS, DIAGCO, EPS, MFLAG, ENERGY, ITMAX, ITDONE, RESET, NP) 37:       CALL DMACRYS_MINIMIZE(N, M, XCOORDS, DIAGCO, EPS, MFLAG, ENERGY, ITMAX, ITDONE, RESET, NP)
 38:       RETURN 38:       RETURN
 39:    END IF 39:    END IF
 40:  40: 
 41: ! hk286 > if generalised rigid body is used, then use rigid coords, otherwise proceed as usual 41: ! hk286 > if generalised rigid body is used, then use rigid coords, otherwise proceed as usual
 42: ! hk286 > When passing rigid coords, pass zeroes from (DEGFREEDOMS+1:3*NATOMS) 42: ! hk286 > When passing rigid coords, pass zeroes from (DEGFREEDOMS+1:3*NATOMS)
 43: ! hk286 > mymylbfgs is the old mylbfgs 43: ! hk286 > mymylbfgs is the old mylbfgs
131: !        CALL MYMYLBFGS(N,M,XCOORDS,DIAGCO,EPS,MFLAG,ENERGY,ITMAX,ITDONE,RESET,NP)131: !        CALL MYMYLBFGS(N,M,XCOORDS,DIAGCO,EPS,MFLAG,ENERGY,ITMAX,ITDONE,RESET,NP)
132: !      END IF132: !      END IF
133: ! hk286133: ! hk286
134: 134: 
135: END SUBROUTINE MYLBFGS135: END SUBROUTINE MYLBFGS
136: 136: 
137: !jk669: wrapper function for selecting minimization algorithm. 3/3/17137: !jk669: wrapper function for selecting minimization algorithm. 3/3/17
138: !Default is LBFGS without line search unless SQNM keyword is present in the data file. 138: !Default is LBFGS without line search unless SQNM keyword is present in the data file. 
139: subroutine min_wrapper(numcoords,mupdates,xcoords,diagco,maxrmsgrad,converget,energy,itermax,iter,reset,np)139: subroutine min_wrapper(numcoords,mupdates,xcoords,diagco,maxrmsgrad,converget,energy,itermax,iter,reset,np)
140: use COMMONS, only: SQNM_HISTMAX, SQNMT140: use COMMONS, only: SQNM_HISTMAX, SQNMT
141: ! use PREC, only: INT32, REAL64141: use PREC, only: INT32, REAL64
142: implicit none 142: implicit none 
143:    !all variables are from mylbfgs except those from COMMONS. 143:    !all variables are from mylbfgs except those from COMMONS. 
144:    integer, intent(in) :: numcoords144:    integer(INT32), intent(in) :: numcoords
145:    integer, intent(in) :: mupdates145:    integer(INT32), intent(in) :: mupdates
146:    DOUBLE PRECISION, intent(inout) :: xcoords(numcoords)146:    real(REAL64), intent(inout) :: xcoords(numcoords)
147:    logical, intent(in) :: diagco147:    logical, intent(in) :: diagco
148:    DOUBLE PRECISION, intent(in) :: maxrmsgrad148:    real(REAL64), intent(in) :: maxrmsgrad
149:    logical, intent(inout) :: converget149:    logical, intent(inout) :: converget
150:    DOUBLE PRECISION, intent(out) :: energy150:    real(REAL64), intent(out) :: energy
151:    integer, intent(in) :: itermax151:    integer(INT32), intent(in) :: itermax
152:    integer, intent(inout) :: iter152:    integer(INT32), intent(inout) :: iter
153:    logical, intent(inout) :: reset153:    logical, intent(inout) :: reset
154:    integer, intent(in) :: np154:    integer(INT32), intent(in) :: np
155: 155: 
156: if (SQNMT) then !SQNM minimizer is turned on. 156: if (SQNMT) then !SQNM minimizer is turned on. 
157:    call sqnm(numcoords,xcoords,maxrmsgrad,SQNM_HISTMAX,converget,energy,itermax,iter)157:    call sqnm(numcoords,xcoords,maxrmsgrad,SQNM_HISTMAX,converget,energy,itermax,iter)
158: else158: else
159:    call MYMYLBFGS(numcoords,mupdates,xcoords,diagco,maxrmsgrad,converget,energy,itermax,iter,reset,np)159:    call MYMYLBFGS(numcoords,mupdates,xcoords,diagco,maxrmsgrad,converget,energy,itermax,iter,reset,np)
160: end if 160: end if 
161: 161: 
162: end subroutine min_wrapper162: end subroutine min_wrapper


r33258/potential.f90 2017-09-01 16:30:22.125081444 +0100 r33257/potential.f90 2017-09-01 16:30:25.193122130 +0100
 35: &                                   AMBER12_NUM_HESS 35: &                                   AMBER12_NUM_HESS
 36:    USE MODHESS, ONLY: HESS, RBAANORMALMODET 36:    USE MODHESS, ONLY: HESS, RBAANORMALMODET
 37:    USE MODAMBER9, ONLY: ATMASS1 37:    USE MODAMBER9, ONLY: ATMASS1
 38:    USE OPEP_INTERFACE_MOD, ONLY: OPEP_ENERGY_AND_GRADIENT, OPEP_NUM_HESS 38:    USE OPEP_INTERFACE_MOD, ONLY: OPEP_ENERGY_AND_GRADIENT, OPEP_NUM_HESS
 39:    USE POLIRMOD, ONLY: POLIR 39:    USE POLIRMOD, ONLY: POLIR
 40:    USE MBPOLMOD, ONLY: MBPOL 40:    USE MBPOLMOD, ONLY: MBPOL
 41:    USE SWMOD, ONLY: SWTYPE 41:    USE SWMOD, ONLY: SWTYPE
 42:    USE MODCUDALBFGS, ONLY: CUDA_ENEGRAD_WRAPPER, CUDA_NUMERICAL_HESS 42:    USE MODCUDALBFGS, ONLY: CUDA_ENEGRAD_WRAPPER, CUDA_NUMERICAL_HESS
 43:    USE GAUSS_MOD, ONLY: GFIELD 43:    USE GAUSS_MOD, ONLY: GFIELD
 44:    USE RAD_MOD, ONLY: RAD, RADR 44:    USE RAD_MOD, ONLY: RAD, RADR
 45:    ! USE PREC, ONLY: INT32, REAL64 45:    USE PREC, ONLY: INT32, REAL64
 46:    USE TWIST_MOD, ONLY: TWISTT, TWIST 46:    USE TWIST_MOD, ONLY: TWISTT, TWIST
 47:    USE CONVEX_POLYHEDRA_MODULE, ONLY: CONVEX_POLYHEDRA 47:    USE CONVEX_POLYHEDRA_MODULE, ONLY: CONVEX_POLYHEDRA
 48:    USE LJ_GAUSS_MOD, ONLY: LJ_GAUSS 48:    USE LJ_GAUSS_MOD, ONLY: LJ_GAUSS
 49:    USE OPP_MOD, ONLY: OPP 49:    USE OPP_MOD, ONLY: OPP
 50:    USE EWALD 50:    USE EWALD
 51:    USE watermethane_mod 51:    USE watermethane_mod
 52:    USE BOX_DERIVATIVES 52:    USE BOX_DERIVATIVES
 53:    IMPLICIT NONE 53:    IMPLICIT NONE
 54: ! Arguments 54: ! Arguments
 55: ! TODO: Work out intents 55: ! TODO: Work out intents
 56: ! TODO: Fix array dimensions? 56: ! TODO: Fix array dimensions?
 57:    DOUBLE PRECISION               :: X(*) 57:    REAL(REAL64)               :: X(*)
 58:    DOUBLE PRECISION               :: GRAD(*) 58:    REAL(REAL64)               :: GRAD(*)
 59:    DOUBLE PRECISION               :: EREAL 59:    REAL(REAL64)               :: EREAL
 60:    LOGICAL, INTENT(IN)        :: GRADT 60:    LOGICAL, INTENT(IN)        :: GRADT
 61:    LOGICAL, INTENT(IN)        :: SECT 61:    LOGICAL, INTENT(IN)        :: SECT
 62: ! Variables 62: ! Variables
 63: ! hk286 > generalised rigid body additions 63: ! hk286 > generalised rigid body additions
 64:    DOUBLE PRECISION               :: XCOORDS(3*NATOMS), GRADATOMS(3*NATOMS), & 64:    REAL(REAL64)               :: XCOORDS(3*NATOMS), GRADATOMS(3*NATOMS), &
 65:                                  XRIGIDCOORDS(3*natoms), XRIGIDGRAD(3*natoms), & 65:                                  XRIGIDCOORDS(3*natoms), XRIGIDGRAD(3*natoms), &
 66:                                  xfrac(3*natoms), gradfrac(3*natoms) 66:                                  xfrac(3*natoms), gradfrac(3*natoms)
 67:    DOUBLE PRECISION, ALLOCATABLE  :: TEMPHESS(:) 67:    REAL(REAL64), ALLOCATABLE  :: TEMPHESS(:)
 68:    DOUBLE PRECISION               :: GRAD1(3*NATOMS) 68:    REAL(REAL64)               :: GRAD1(3*NATOMS)
 69:    INTEGER             :: I, J, K 69:    INTEGER(INT32)             :: I, J, K
 70:    DOUBLE PRECISION               :: XRIGIDHESS(DEGFREEDOMS, DEGFREEDOMS) 70:    REAL(REAL64)               :: XRIGIDHESS(DEGFREEDOMS, DEGFREEDOMS)
 71:    LOGICAL                    :: FTEST, EVAP, COMPON, YESNO, GUIDET, EVAPREJECT 71:    LOGICAL                    :: FTEST, EVAP, COMPON, YESNO, GUIDET, EVAPREJECT
 72:    INTEGER             :: J1, J2, J3, CSMIT 72:    INTEGER(INT32)             :: J1, J2, J3, CSMIT
 73:    CHARACTER                  :: FNAME*80, DUMM*4 73:    CHARACTER                  :: FNAME*80, DUMM*4
 74:    DOUBLE PRECISION               :: DUMMY2, GEMAX, RMAT(3, 3), XTEMP(3*NATOMS), AVVAL, & 74:    REAL(REAL64)               :: DUMMY2, GEMAX, RMAT(3, 3), XTEMP(3*NATOMS), AVVAL, &
 75:                                  DUMMY(3*NATOMS), DIST2, QE, QX, AA(3), SAVECSMNORM, & 75:                                  DUMMY(3*NATOMS), DIST2, QE, QX, AA(3), SAVECSMNORM, &
 76:                                  CSMRMS, CSMGRAD(3), SAVECSMPMAT(3, 3), & 76:                                  CSMRMS, CSMGRAD(3), SAVECSMPMAT(3, 3), &
 77:                                  SAVECSMIMAGES(3*NATOMS*CSMGPINDEX)!, BOXPARAMS(6) 77:                                  SAVECSMIMAGES(3*NATOMS*CSMGPINDEX)!, BOXPARAMS(6)
 78:    CHARACTER(LEN=3)           :: CSMGPSAVE 78:    CHARACTER(LEN=3)           :: CSMGPSAVE
 79:    INTEGER             :: CSMGPINDEXSAVE 79:    INTEGER(INT32)             :: CSMGPINDEXSAVE
 80:    DOUBLE PRECISION               :: PTGPSAVE(3, 3, 2*CSMGPINDEX), CSMNORMSAVE, ENERGY, VNEW(3*NATOMS) 80:    REAL(REAL64)               :: PTGPSAVE(3, 3, 2*CSMGPINDEX), CSMNORMSAVE, ENERGY, VNEW(3*NATOMS)
 81: !   INTEGER             :: BRUN 81: !   INTEGER(INT32)             :: BRUN
 82:    INTEGER             :: NQTOT 82:    INTEGER(INT32)             :: NQTOT
 83:    LOGICAL                    :: SOCOUPLE, GUIDECHANGET, CSMDOGUIDET, COMTEST, LJADD3DOGUIDET 83:    LOGICAL                    :: SOCOUPLE, GUIDECHANGET, CSMDOGUIDET, COMTEST, LJADD3DOGUIDET
 84: ! khs26 > AMBER12 energy decomposition, type defined in AMBER12 interface 84: ! khs26 > AMBER12 energy decomposition, type defined in AMBER12 interface
 85:    TYPE(POT_ENE_REC_C)        :: AMBER12_ENERGY_DECOMP 85:    TYPE(POT_ENE_REC_C)        :: AMBER12_ENERGY_DECOMP
 86: !Used only in commented sections 86: !Used only in commented sections
 87:    DOUBLE PRECISION               :: GRADDUM(3*NATOMS), EPLUS, EMINUS, DIFF!, TERMLJ, TERMMF, & 87:    REAL(REAL64)               :: GRADDUM(3*NATOMS), EPLUS, EMINUS, DIFF!, TERMLJ, TERMMF, &
 88:                                  !, XG, YG, ZG, RMS1, RMS2, GRADLJ(3*NATOMS), GRADMF(3*NATOMS), & 88:                                  !, XG, YG, ZG, RMS1, RMS2, GRADLJ(3*NATOMS), GRADMF(3*NATOMS), &
 89: !                                GRADDUM1(3*NATOMS), GRADDUM2(3*NATOMS), EREALLJ, EREALMF, EDUM1, EDUM2 89: !                                GRADDUM1(3*NATOMS), GRADDUM2(3*NATOMS), EREALLJ, EREALMF, EDUM1, EDUM2
 90: !DS656> GRADIENT/HESSIAN TESTING 90: !DS656> GRADIENT/HESSIAN TESTING
 91:    DOUBLE PRECISION :: GPLUS(3*NATOMS), GMINUS(3*NATOMS) 91:    DOUBLE PRECISION :: GPLUS(3*NATOMS), GMINUS(3*NATOMS)
 92:    integer          :: nbox 92:    integer          :: nbox
 93:  93: 
 94: ! TODO: Delete common blocks 94: ! TODO: Delete common blocks
 95:    COMMON /CO/ COMPON 95:    COMMON /CO/ COMPON
 96:    COMMON /FAIL/ FTEST 96:    COMMON /FAIL/ FTEST
 97:    COMMON /EV/ EVAP, EVAPREJECT 97:    COMMON /EV/ EVAP, EVAPREJECT
526:    ELSE IF (SW) THEN526:    ELSE IF (SW) THEN
527:       IF (PERIODIC) THEN527:       IF (PERIODIC) THEN
528:          CALL SISW(X, GRAD, EREAL, GRADT)528:          CALL SISW(X, GRAD, EREAL, GRADT)
529:       ELSE529:       ELSE
530:          CALL RAD(X, GRAD, EREAL, GRADT)530:          CALL RAD(X, GRAD, EREAL, GRADT)
531:          CALL SWTWO(X, GRAD, EREAL, GRADT)531:          CALL SWTWO(X, GRAD, EREAL, GRADT)
532:          CALL SWTHREE(GRAD, EREAL, GRADT)532:          CALL SWTHREE(GRAD, EREAL, GRADT)
533:       END IF533:       END IF
534: 534: 
535:    ELSE IF (QUIPT) THEN535:    ELSE IF (QUIPT) THEN
536:       IF ((.NOT.PERCOLATET).AND.(.NOT.PERIODIC)) CALL RAD(X, GRAD, EREAL, GRADT)536:       IF (.NOT. PERCOLATET) CALL RAD(X, GRAD, EREAL, GRADT)
537:       CALL GMIN_QUIP_WRAPPER(X, GRAD, EREAL)537:       CALL GMIN_QUIP_WRAPPER(X, GRAD, EREAL, QUIPATOMTYPE, QUIPARGSTR)
538: 538: 
539:    ELSE IF (AMHT) THEN539:    ELSE IF (AMHT) THEN
540:       CALL WALESAMH_INTERFACE(X, GRAD, EREAL)540:       CALL WALESAMH_INTERFACE(X, GRAD, EREAL)
541: !      DIFF=1.0D-4541: !      DIFF=1.0D-4
542: !      SUMMDIFF=0.D0542: !      SUMMDIFF=0.D0
543: !      WRITE(*, *) 'analytic and numerical gradients:'543: !      WRITE(*, *) 'analytic and numerical gradients:'
544: !      DO J1=1, 3*NATOMS544: !      DO J1=1, 3*NATOMS
545: !         WRITE(*,'(F20.10, 2x, F20.10, 2xI5)')X(J1), GRAD(J1), J1545: !         WRITE(*,'(F20.10, 2x, F20.10, 2xI5)')X(J1), GRAD(J1), J1
546: !         X(J1)=X(J1)+DIFF546: !         X(J1)=X(J1)+DIFF
547: !         CALL SCLTAB_WALES(X, GRADDUM, EPLUS)547: !         CALL SCLTAB_WALES(X, GRADDUM, EPLUS)


r33258/sqnm.f90 2017-09-01 16:30:22.425085424 +0100 r33257/sqnm.f90 2017-09-01 16:30:25.413125047 +0100
898: !   INFO = 1  THE SUFFICIENT DECREASE CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION HOLD.898: !   INFO = 1  THE SUFFICIENT DECREASE CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION HOLD.
899: !   INFO = 2  RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY IS AT MOST XTOL.899: !   INFO = 2  RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY IS AT MOST XTOL.
900: !   INFO = 3  NUMBER OF CALLS TO FCN HAS REACHED MAXFEV.900: !   INFO = 3  NUMBER OF CALLS TO FCN HAS REACHED MAXFEV.
901: !   INFO = 4  THE STEP IS AT THE LOWER BOUND STPMIN.901: !   INFO = 4  THE STEP IS AT THE LOWER BOUND STPMIN.
902: !   INFO = 5  THE STEP IS AT THE UPPER BOUND STPMAX.902: !   INFO = 5  THE STEP IS AT THE UPPER BOUND STPMAX.
903: !   INFO = 6  ROUNDING ERRORS PREVENT FURTHER PROGRESS. THERE MAY NOT BE A STEP WHICH SATISFIES THE903: !   INFO = 6  ROUNDING ERRORS PREVENT FURTHER PROGRESS. THERE MAY NOT BE A STEP WHICH SATISFIES THE
904: !          SUFFICIENT DECREASE AND CURVATURE CONDITIONS. TOLERANCES MAY BE TOO SMALL.904: !          SUFFICIENT DECREASE AND CURVATURE CONDITIONS. TOLERANCES MAY BE TOO SMALL.
905: !   info = 7  search direction was not a descent direction905: !   info = 7  search direction was not a descent direction
906: ! NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF CALLS TO FCN.906: ! NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF CALLS TO FCN.
907: ! WA IS A WORK ARRAY OF LENGTH N.907: ! WA IS A WORK ARRAY OF LENGTH N.
908: ! SUBPROGRAMS CALLED: MYMCSTEP908: ! SUBPROGRAMS CALLED: MCSTEP
909: ! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 JORGE J. MORE', DAVID J. THUENTE909: ! ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 JORGE J. MORE', DAVID J. THUENTE
910: 910: 
911:     double precision, parameter :: GTOL = 1.0d-1 !controls the accuracy of the line search routine MCSRCH.911:     double precision, parameter :: GTOL = 1.0d-1 !controls the accuracy of the line search routine MCSRCH.
912:     double precision, parameter :: STPMIN = 1.0d-20912:     double precision, parameter :: STPMIN = 1.0d-20
913:     double precision, parameter :: STPMAX = 1.0d5913:     double precision, parameter :: STPMAX = 1.0d5
914:     double precision, parameter :: XTOL = epsilon(1.0d0) 914:     double precision, parameter :: XTOL = epsilon(1.0d0) 
915: 915: 
916:     INTEGER :: INFOC=6916:     INTEGER :: INFOC=6
917:     LOGICAL :: BRACKT,STAGE1917:     LOGICAL :: BRACKT,STAGE1
918:     DOUBLE PRECISION :: DG,DGM,DGINIT,DGTEST,DGX,DGXM,DGY,DGYM,FINIT,FTEST1,FM,FX,FXM,FY,FYM,STX,STY918:     DOUBLE PRECISION :: DG,DGM,DGINIT,DGTEST,DGX,DGXM,DGY,DGYM,FINIT,FTEST1,FM,FX,FXM,FY,FYM,STX,STY
1000:         ! FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN1000:         ! FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN
1001:         ! OBTAINED BUT THE DECREASE IS NOT SUFFICIENT.1001:         ! OBTAINED BUT THE DECREASE IS NOT SUFFICIENT.
1002:         IF (STAGE1 .AND. F .LE. FX .AND. F .GT. FTEST1) THEN1002:         IF (STAGE1 .AND. F .LE. FX .AND. F .GT. FTEST1) THEN
1003:             ! DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES.1003:             ! DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES.
1004:             FM = F - STP*DGTEST1004:             FM = F - STP*DGTEST
1005:             FXM = FX - STX*DGTEST1005:             FXM = FX - STX*DGTEST
1006:             FYM = FY - STY*DGTEST1006:             FYM = FY - STY*DGTEST
1007:             DGM = DG - DGTEST1007:             DGM = DG - DGTEST
1008:             DGXM = DGX - DGTEST1008:             DGXM = DGX - DGTEST
1009:             DGYM = DGY - DGTEST1009:             DGYM = DGY - DGTEST
1010:             ! CALL MYMCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY AND TO COMPUTE THE NEW STEP.1010:             ! CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY AND TO COMPUTE THE NEW STEP.
1011:             CALL MYMCSTEP(STX,FXM,DGXM,STY,FYM,DGYM,STP,FM,DGM,BRACKT,STMIN,STMAX,INFOC)1011:             CALL MCSTEP(STX,FXM,DGXM,STY,FYM,DGYM,STP,FM,DGM,BRACKT,STMIN,STMAX,INFOC)
1012: 1012: 
1013:             ! RESET THE FUNCTION AND GRADIENT VALUES FOR F.1013:             ! RESET THE FUNCTION AND GRADIENT VALUES FOR F.
1014:             FX = FXM + STX*DGTEST1014:             FX = FXM + STX*DGTEST
1015:             FY = FYM + STY*DGTEST1015:             FY = FYM + STY*DGTEST
1016:             DGX = DGXM + DGTEST1016:             DGX = DGXM + DGTEST
1017:             DGY = DGYM + DGTEST1017:             DGY = DGYM + DGTEST
1018:         ELSE1018:         ELSE
1019:             ! CALL MYMCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY AND TO COMPUTE THE NEW STEP.1019:             ! CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY AND TO COMPUTE THE NEW STEP.
1020:             CALL MYMCSTEP(STX,FX,DGX,STY,FY,DGY,STP,F,DG,BRACKT,STMIN,STMAX,INFOC)1020:             CALL MCSTEP(STX,FX,DGX,STY,FY,DGY,STP,F,DG,BRACKT,STMIN,STMAX,INFOC)
1021:         END IF1021:         END IF
1022: 1022: 
1023:         ! FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE INTERVAL OF UNCERTAINTY.1023:         ! FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE INTERVAL OF UNCERTAINTY.
1024:         IF (BRACKT) THEN1024:         IF (BRACKT) THEN
1025:             IF (ABS(STY-STX) .GE. P66*WIDTH1) STP = STX + P5*(STY - STX)1025:             IF (ABS(STY-STX) .GE. P66*WIDTH1) STP = STX + P5*(STY - STX)
1026:             WIDTH1 = WIDTH1026:             WIDTH1 = WIDTH
1027:             WIDTH = ABS(STY-STX)1027:             WIDTH = ABS(STY-STX)
1028:         END IF1028:         END IF
1029:         1029:         
1030:     end do1030:     end do
1031: end subroutine linesearch1031: end subroutine linesearch
1032: 1032: 
1033: !===========================================================================================================1033: !===========================================================================================================
1034: SUBROUTINE MYMCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,STPMIN,STPMAX,INFO)1034: SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,STPMIN,STPMAX,INFO)
1035: implicit none1035: implicit none
1036:     INTEGER INFO1036:     INTEGER INFO
1037:     DOUBLE PRECISION STX,FX,DX,STY,FY,DY,STP,FP,DP,STPMIN,STPMAX1037:     DOUBLE PRECISION STX,FX,DX,STY,FY,DY,STP,FP,DP,STPMIN,STPMAX
1038:     LOGICAL BRACKT,BOUND1038:     LOGICAL BRACKT,BOUND
1039: 1039: 
1040: ! THE PURPOSE OF MYMCSTEP IS TO COMPUTE A SAFEGUARDED STEP FOR A LINESEARCH AND TO UPDATE AN INTERVAL OF UNCERTAINTY FOR1040: ! THE PURPOSE OF MCSTEP IS TO COMPUTE A SAFEGUARDED STEP FOR A LINESEARCH AND TO UPDATE AN INTERVAL OF UNCERTAINTY FOR
1041: ! A MINIMIZER OF THE FUNCTION.1041: ! A MINIMIZER OF THE FUNCTION.
1042: ! THE PARAMETER STX CONTAINS THE STEP WITH THE LEAST FUNCTION VALUE. THE PARAMETER STP CONTAINS THE CURRENT STEP. IT IS1042: ! THE PARAMETER STX CONTAINS THE STEP WITH THE LEAST FUNCTION VALUE. THE PARAMETER STP CONTAINS THE CURRENT STEP. IT IS
1043: ! ASSUMED THAT THE DERIVATIVE AT STX IS NEGATIVE IN THE DIRECTION OF THE STEP. IF BRACKT IS SET TRUE THEN A1043: ! ASSUMED THAT THE DERIVATIVE AT STX IS NEGATIVE IN THE DIRECTION OF THE STEP. IF BRACKT IS SET TRUE THEN A
1044: ! MINIMIZER HAS BEEN BRACKETED IN AN INTERVAL OF UNCERTAINTY WITH ENDPOINTS STX AND STY.1044: ! MINIMIZER HAS BEEN BRACKETED IN AN INTERVAL OF UNCERTAINTY WITH ENDPOINTS STX AND STY.
1045: ! THE SUBROUTINE STATEMENT IS SUBROUTINE MYMCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,STPMIN,STPMAX,INFO) WHERE1045: ! THE SUBROUTINE STATEMENT IS SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,STPMIN,STPMAX,INFO) WHERE
1046: ! STX, FX, AND DX ARE VARIABLES WHICH SPECIFY THE STEP, THE FUNCTION, AND THE DERIVATIVE AT THE BEST STEP OBTAINED1046: ! STX, FX, AND DX ARE VARIABLES WHICH SPECIFY THE STEP, THE FUNCTION, AND THE DERIVATIVE AT THE BEST STEP OBTAINED
1047: !     SO FAR. THE DERIVATIVE MUST BE NEGATIVE IN THE DIRECTION OF THE STEP, THAT IS, DX AND STP-STX MUST HAVE OPPOSITE1047: !     SO FAR. THE DERIVATIVE MUST BE NEGATIVE IN THE DIRECTION OF THE STEP, THAT IS, DX AND STP-STX MUST HAVE OPPOSITE
1048: !     SIGNS. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY.1048: !     SIGNS. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY.
1049: ! STY, FY, AND DY ARE VARIABLES WHICH SPECIFY THE STEP, THE FUNCTION, AND THE DERIVATIVE AT THE OTHER ENDPOINT OF1049: ! STY, FY, AND DY ARE VARIABLES WHICH SPECIFY THE STEP, THE FUNCTION, AND THE DERIVATIVE AT THE OTHER ENDPOINT OF
1050: !     THE INTERVAL OF UNCERTAINTY. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY.1050: !     THE INTERVAL OF UNCERTAINTY. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY.
1051: ! STP, FP, AND DP ARE VARIABLES WHICH SPECIFY THE STEP, THE FUNCTION, AND THE DERIVATIVE AT THE CURRENT STEP.1051: ! STP, FP, AND DP ARE VARIABLES WHICH SPECIFY THE STEP, THE FUNCTION, AND THE DERIVATIVE AT THE CURRENT STEP.
1052: !     IF BRACKT IS SET TRUE THEN ON INPUT STP MUST BE BETWEEN STX AND STY. ON OUTPUT STP IS SET TO THE NEW STEP.1052: !     IF BRACKT IS SET TRUE THEN ON INPUT STP MUST BE BETWEEN STX AND STY. ON OUTPUT STP IS SET TO THE NEW STEP.
1053: !     BRACKT IS A LOGICAL VARIABLE WHICH SPECIFIES IF A MINIMIZER HAS BEEN BRACKETED. IF THE MINIMIZER HAS NOT BEEN BRACKETED1053: !     BRACKT IS A LOGICAL VARIABLE WHICH SPECIFIES IF A MINIMIZER HAS BEEN BRACKETED. IF THE MINIMIZER HAS NOT BEEN BRACKETED
1054: !     THEN ON INPUT BRACKT MUST BE SET FALSE. IF THE MINIMIZER IS BRACKETED THEN ON OUTPUT BRACKT IS SET TRUE.1054: !     THEN ON INPUT BRACKT MUST BE SET FALSE. IF THE MINIMIZER IS BRACKETED THEN ON OUTPUT BRACKT IS SET TRUE.
1055: ! STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP.1055: ! STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP.
1244:     STPF = MAX(STPMIN,STPF)1244:     STPF = MAX(STPMIN,STPF)
1245:     STP = STPF1245:     STP = STPF
1246:     IF (BRACKT .AND. BOUND) THEN1246:     IF (BRACKT .AND. BOUND) THEN
1247:         IF (STY .GT. STX) THEN1247:         IF (STY .GT. STX) THEN
1248:             STP = MIN(STX+0.66*(STY-STX),STP)1248:             STP = MIN(STX+0.66*(STY-STX),STP)
1249:         ELSE1249:         ELSE
1250:             STP = MAX(STX+0.66*(STY-STX),STP)1250:             STP = MAX(STX+0.66*(STY-STX),STP)
1251:         END IF1251:         END IF
1252:     END IF1252:     END IF
1253:     RETURN1253:     RETURN
1254: END subroutine mymcstep 1254: END subroutine mcstep 


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0